辛亥百年纪念 - 产品组件系列01

“天下为公”

---------------------------

《读取注册表信息》

此组件目的：读取相关键值，并按照一定的顺序组合他们。

此组件用途：密码存放

==Code=========

{*--------------------------------------------------------------------------
   Delphi菜鸟XiaoBin  2006.5.31于黑龙江草甸子

http://blog.youkuaiyun.com/xiaobin_hlj80

veic_2005@163.com
--------------------------------------------------------------------------*}


unit UreadReg;

interface
uses
  Windows, SysUtils, Registry, Classes, Forms, StrUtils;

//
  type
  TreadXBF=function(DimRecord: Integer;filename1:WideString):WideString;stdcall;
  //


var
  myreg:TRegistry;
  childstr1,childstr6:string[1];
  childstr4,childstr5:string[2];
  childstr2,childstr3:string[4];
  installbool:Boolean;
  connstring:TreadXBF;

Function readREG(xbf:WideString):WideString;


implementation


Function readREG(xbf:WideString):WideString;
var
  XBFconnect:string;
  XBFconn1,REGconn2,XBFconn3:string;
  tempregbin:array [0..15]of char;
  XBFlen:integer;
  h1:THandle;
  //
  P : PChar;
  Err : DWord;
  ErrStr:string;
  year,month,day,DOW:Word;
  dayStr,monthStr:string;
  nowdate:string;
  installdate:string;
  TimeLag:integer;
  //2007.1.6定位密码位置
  pwdCoordinate:integer;
begin
  myreg:=TRegistry.Create;
  with myreg.Create do
  begin
    myreg.RootKey:=HKEY_LOCAL_MACHINE;

    if not OpenKey('SoftWare\veic\cps',False)then
    begin
      Application.MessageBox('操作系统出现问题或人为恶意改动！','OS ERROR',MB_OK);
      CloseKey;
      Application.Terminate;
    end;
    //内嵌过程start
    P := pchar('yyyy-MM-dd');
    if SetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SSHORTDATE,P) then
    begin
      //
    end
    else
    begin
      Err := GetLastError;
      case Err of
        ERROR_INVALID_ACCESS : ErrStr:='INVALID_ACCESS';
        ERROR_INVALID_FLAGS  : ErrStr:='INVALID_FLAGS';
        ERROR_INVALID_PARAMETER : ErrStr:='INVALID_PARAMETER';
      end;
    end;
    DecodeDateFully(Now,year,month,day,DOW);
    if month<10 then
    begin
      monthStr:='0'+IntToStr(month);
    end else monthStr:=IntToStr(month);
    if day<10 then
    begin
      dayStr:='0'+IntToStr(day);
    end else dayStr:= IntToStr(day);
    nowdate:=IntToStr(year)+monthStr+dayStr;
    if ValueExists('InstallDate')then
    begin
      installdate:=myreg.ReadString('InstallDate');
      TimeLag:=StrToInt(nowdate)-StrToInt(installdate);
      DateTimeToFileDate(Now);
      //判断时间差(begin)
      if TimeLag>300000 then
      begin
        //
      end;
     //判断时间差(end)
    end
    else
    begin
      installbool:=True;
      Application.MessageBox('丢失安装信息，程序无法运行！','OS ERROR',MB_OK);
      Application.Terminate;
    end;


    //内嵌过程stop


    if ValueExists('support1')then
    begin
      myreg.ReadBinaryData('support1',tempregbin,4);
      childstr1:= tempregbin
    end
    else
    begin
      installbool:=True;
      exit;
    end;

    if ValueExists('support2')then
    begin
      myreg.ReadBinaryData('support2',tempregbin,16);
      childstr2:= tempregbin
     end
     else
     begin
       installbool:=True;
       exit;
     end;

     if ValueExists('support3')then
     begin
       myreg.ReadBinaryData('support3',tempregbin,16);
       childstr3:= tempregbin
     end
     else
     begin
       installbool:=True;
       exit;
     end;

     if ValueExists('support4')then
     begin
       myreg.ReadBinaryData('support4',tempregbin,8);
       childstr4:= tempregbin
     end
     else
     begin
       installbool:=True;
       exit;
     end;

     if ValueExists('support5')then
     begin
       myreg.ReadBinaryData('support5',tempregbin,8);
       childstr5:= tempregbin
     end
     else
     begin
       installbool:=True;
       exit;
     end;

     if ValueExists('support6')then
     begin
       myreg.ReadBinaryData('support6',tempregbin,4);
       childstr6:= tempregbin
     end
     else
     begin
       Application.MessageBox('丢失安装信息，程序无法运行！','OS ERROR',MB_OK);
       installbool:=True;
       exit;
     end;
  end;//withend
  REGconn2:=childstr2+childstr5+childstr6+childstr1+childstr3+childstr4;
  try
     h1:=0;
     try
      h1:=LoadLibrary('XBFGenerate.dll');

      if h1<>0 then
        @connstring:=GetprocAddress(h1,'readXBF');
      if (@connstring<>nil)then
          XBFconnect:=connstring(-1,xbf);
     finally
       FreeLibrary(h1);
     end;
  except
    Application.MessageBox('配置错误，请重新填写各个值！','提示',MB_OK);
    Exit;
  end;
  //XBFconnect:=readXBF(-1,xbf);
  XBFconn1:=LeftStr(XBFconnect,29);
  //2007.1.6定位密码位置
  pwdCoordinate:=pos(';Pe',XBFconnect);
  XBFlen:=length(XBFconnect);
  XBFconn3:=RightStr(XBFconnect,XBFlen-pwdCoordinate+1);

  Result:=XBFconn1+REGconn2+XBFconn3;

end;

end.