文章标题

---

unit Main;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, IniFiles,Graphics, Controls, Forms,  Dialogs, IdHashMessageDigest,StdCtrls, IdBaseComponent, IdComponent,  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, ShellAPI,Registry,IdFTP,  ComCtrls, ExtCtrls, CheckLst;Type FileRec = Record  FileName :string;  Att :String;  Size :integer;  ModiDate :stringend;type  TfrmMain = class(TForm)    btnpalBBS: TButton;    Button10: TButton;    IdFTP1: TIdFTP;    Note: TMemo;    GroupBox4: TGroupBox;    edLicFile: TEdit;    Button3: TButton;    Label4: TLabel;    edUser: TEdit;    PageControl1: TPageControl;    TabSheet1: TTabSheet;    功能: TTabSheet;    lbRegFun: TListBox;    Panel1: TPanel;    rbReg: TRadioButton;    rbRegDate: TRadioButton;    edRegDate: TEdit;    Label5: TLabel;    rdCid: TEdit;    memLic: TMemo;    clbClass: TCheckListBox;    Label3: TLabel;    Label1: TLabel;    cbFtpList: TComboBox;    btnReceive: TButton;    btnAct: TButton;    //Procedure getActCode;    procedure FormCreate(Sender: TObject);  //  procedure btnReceiveClick(Sender: TObject);    //procedure btnActClick(Sender: TObject);    //procedure btnCheckClick(Sender: TObject);    procedure btnpalBBSClick(Sender: TObject);    procedure edUserChange(Sender: TObject);    procedure rbRegClick(Sender: TObject);    procedure rbRegDateClick(Sender: TObject);    procedure clbClassClick(Sender: TObject);    procedure lbRegFunClick(Sender: TObject);    procedure Button3Click(Sender: TObject);  private    { Private declarations }        BytesToTransfer: LongWord;  public    { Public declarations }  end;  typeTMD5 = class(TIdHashMessageDigest5);var  frmMain: TfrmMain;  strLicMd5:string;  downfilename,downloadpath:string;  lini:Tinifile;  FTP_ptoclose,FTP_user,FTP_psw,FTP_svrip,FTP_path:string;implementation{$R *.dfm}// ================窗体动作==================={功能：使用传递参数确认某软件注册情况1.接收软件名传递参数2.检查注册档是否已认证，3.检查正在运行的软件是否可通过（足够的金币，注册，使用期限）4.以环境变量形式发送使用授权信息5.运行结束是否进入ftp真伪认证，一次真伪认证可使用100次。}function GetCDiskDriveInfo: Pchar; // 获得C盘IDvar  InfoID: Byte;  NotUsed: DWORD;  VolumeFlags: DWORD;  VolumeInfo: array [0 .. MAX_PATH] of Char;  VolumeSerialNumber: DWORD;begin  try    GetVolumeInformation(Pchar('C:\'), VolumeInfo, SizeOf(VolumeInfo),      @VolumeSerialNumber, NotUsed, VolumeFlags, nil, 0);    case 1 of      1:        Result := Pchar(Format('%8.8X', [VolumeSerialNumber]));      2:        Result := VolumeInfo;    else      Result := 'JiiYi';    end;  except    on E: Exception do      Result := '执行错误!';  end;end;function StreamToMD5(S: TFileStream): String;var  Md5Encode: TMD5;begin  Md5Encode := TMD5.Create;  try    Result := Md5Encode.HashStreamAsHex(S);  finally    Md5Encode.Free;  end;end;procedure TfrmMain.FormCreate(Sender: TObject);var  licFile, licMD5: string;  filesen: TFileStream;begin  licFile := 'C:\PalPCB\Allegro\Pcbenv\License.dat';  if fileexists(licFile) then  begin    // 读取MD5码    filesen := TFileStream.Create(licFile, fmOpenRead or fmShareExclusive);    licMD5 := StreamToMD5(filesen);    strLicMd5 := licMD5;    filesen.Free;  end  else    strLicMd5 := 'File not found!';  //表单自动填写  downloadpath := 'C:\PalEDA\Allegro\Env\';                                     //env路径  rdCid.Text := GetCDiskDriveInfo;    // 获取C盘ID                              //机器码  if not DirectoryExists(downloadpath) then ForceDirectories(downloadpath);  downfilename := downloadpath + rdCid.Text + '.reg';                           //注册文件名  edRegDate.Text:=datetostr(now+365);  //lic文件读写  edLicFile.Text:= downloadpath + rdCid.Text +'.dat';                           //表单文件名  if FileExists(edLicFile.Text) then  memLic.Lines.LoadFromFile(edLicFile.Text);  lini:=Tinifile.Create(edLicFile.Text);  lini.WriteString('instructions','ComputerID',rdCid.Text);  edUser.Text:=lini.ReadString('instructions','UserName','');//  getActCode;end;procedure TfrmMain.edUserChange(Sender: TObject);begin  lini.WriteString('instructions','UserName',edUser.Text);  memLic.Lines.LoadFromFile(edLicFile.Text);end;procedure TfrmMain.clbClassClick(Sender: TObject);begincase clbClass.ItemIndex of0:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','File','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','File',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','File','');end;1:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Display','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Display',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Display','');end;2:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Pcbenv','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Pcbenv',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Pcbenv','');end;3:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Logic','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Logic',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Logic','');end;4:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Edit','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Edit',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Edit','');end;5:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Place','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Place',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Place','');end;6:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Route','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Route',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Route','');end;7:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Find','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Find',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Find','');end;8:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Compare','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Compare',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Compare','');end;9:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Tools','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Tools',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Tools','');end;10:begin  if (clbClass.Checked[clbClass.ItemIndex] and rbReg.Checked)     then lini.WriteString('instructions','Skill','reg');  if (clbClass.Checked[clbClass.ItemIndex] and rbRegDate.Checked) then lini.WriteString('instructions','Skill',edRegDate.Text);  if not clbClass.Checked[clbClass.ItemIndex]                     then lini.WriteString('instructions','Skill','');end;end;memLic.Lines.LoadFromFile(edLicFile.Text);end;procedure TfrmMain.rbRegClick(Sender: TObject);var i:integer;beginedRegDate.Enabled:=rbRegDate.Checked;for I := 0 to clbClass.Items.Count - 1 do  clbClass.Checked[i]:=false;if lini.ReadString('instructions','File','')='reg' then clbClass.Checked[0]:=true;if lini.ReadString('instructions','Display','')='reg' then clbClass.Checked[1]:=true;if lini.ReadString('instructions','Pcbenv','')='reg' then clbClass.Checked[2]:=true;if lini.ReadString('instructions','Logic','')='reg' then clbClass.Checked[3]:=true;if lini.ReadString('instructions','Edit','')='reg' then clbClass.Checked[4]:=true;if lini.ReadString('instructions','Place','')='reg' then clbClass.Checked[5]:=true;if lini.ReadString('instructions','Route','')='reg' then clbClass.Checked[6]:=true;if lini.ReadString('instructions','Find','')='reg' then clbClass.Checked[7]:=true;if lini.ReadString('instructions','Compare','')='reg' then clbClass.Checked[8]:=true;if lini.ReadString('instructions','Tools','')='reg' then clbClass.Checked[9]:=true;if lini.ReadString('instructions','Skill','')='reg' then clbClass.Checked[10]:=true;end;procedure TfrmMain.rbRegDateClick(Sender: TObject);var i:integer;beginedRegDate.Enabled:=rbRegDate.Checked;for I := 0 to clbClass.Items.Count - 1 do  clbClass.Checked[i]:=false;if lini.ReadString('instructions','File','')=edRegDate.Text then clbClass.Checked[0]:=true;if lini.ReadString('instructions','Display','')=edRegDate.Text then clbClass.Checked[1]:=true;if lini.ReadString('instructions','Pcbenv','')=edRegDate.Text then clbClass.Checked[2]:=true;if lini.ReadString('instructions','Logic','')=edRegDate.Text then clbClass.Checked[3]:=true;if lini.ReadString('instructions','Edit','')=edRegDate.Text then clbClass.Checked[4]:=true;if lini.ReadString('instructions','Place','')=edRegDate.Text then clbClass.Checked[5]:=true;if lini.ReadString('instructions','Route','')=edRegDate.Text then clbClass.Checked[6]:=true;if lini.ReadString('instructions','Find','')=edRegDate.Text then clbClass.Checked[7]:=true;if lini.ReadString('instructions','Compare','')=edRegDate.Text then clbClass.Checked[8]:=true;if lini.ReadString('instructions','Tools','')=edRegDate.Text then clbClass.Checked[9]:=true;if lini.ReadString('instructions','Skill','')=edRegDate.Text then clbClass.Checked[10]:=true;end;procedure TfrmMain.lbRegFunClick(Sender: TObject);begincase lbRegFun.ItemIndex of0:begin  lini.WriteString('instructions','File',datetostr(now+365));  lini.WriteString('instructions','Display',datetostr(now+365));  lini.WriteString('instructions','Pcbenv',datetostr(now+365));  lini.WriteString('instructions','Logic',datetostr(now+365));  lini.WriteString('instructions','Edit',datetostr(now+365));  lini.WriteString('instructions','Place',datetostr(now+365));  lini.WriteString('instructions','Route',datetostr(now+365));  lini.WriteString('instructions','Find',datetostr(now+365));  lini.WriteString('instructions','Compare',datetostr(now+365));  lini.WriteString('instructions','Tools',datetostr(now+365));  lini.WriteString('instructions','Skill',datetostr(now+365));end;end;memLic.Lines.LoadFromFile(edLicFile.Text);end;procedure TfrmMain.Button3Click(Sender: TObject);begin  lini.WriteString('instructions','ModifyDate',datetostr(now)); FTP_ptoclose:='PalPCB'; FTP_user:='PalPCB'; FTP_psw:='palpilot'; FTP_svrip:='ftp.palpilot.com.tw'; FTP_path:='/FTP_A/PE/PalPCB/test';end;//--------------------帮助---------------------procedure TfrmMain.btnpalBBSClick(Sender: TObject);var  qskype: string;begin  qskype := 'skype:?chat&blob=cLCKxLNh9O3ruyy7NNYdQUXoUORDrK-KVcwsO3fsOZNyi7y0CFMdbxa-R3hTkMOZyN9dEAxwkpyj13un';  ShellExecute(handle, 'open', pwidechar(qskype), '', '', SW_NORMAL);end;end.// =====================栓查注册档========================procedure TfrmMain.btnCheckClick(Sender: TObject);var  Reg: TRegistry;  AppKey, regSoft, keyname, regkey: string;begin  Reg := TRegistry.Create;  try    Reg.RootKey := HKey_Current_User;    // 设置根键，    AppKey := '\Software\PalPCB\Reg';    keyname := rdCid.Text;    if not Reg.OpenKey(AppKey, true) then    begin      Reg.CreateKey(AppKey);      Reg.OpenKey(AppKey, true);    end;    Reg.OpenKey(AppKey, true);    regkey := Reg.ReadString(keyname);    if strLicMd5 = regkey then      Note.Lines.Add('License.dat==>已认证！')    else      Note.Lines.Add('License.dat==>未认证或被修改，请重新提交！') finally  end;end;procedure TfrmMain.btnViewClick(Sender: TObject);var  sllicFile: Tstringlist;begin  sllicFile := Tstringlist.Create;  sllicFile.LoadFromFile(edLicFile.Text);  showmessage(sllicFile.Text);end;function SetGlobalEnvironment(const Name,Value:string):boolean;const REG_LOCATION='System/CurrentControlSet/Control/Session Manager/Environment';var R:DWORD;begin with TRegistry.Create do try   RootKey :=HKEY_LOCAL_MACHINE;   Result :=OpenKey(REG_LOCATION,True);   if Result then   begin     WriteString(Name,Value);     SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,integer(Pchar('Environment')));//      SendMessageTimeOut(HWND_BROADCAST,WM_SETTINGCHANGE,0,integer(Pchar('Environment')),SMTO_NORMAL,1000,R);   end; finally   Free; end;end;//===================激活====================Procedure TfrmMain.getActCode;var  stlCode: Tstringlist;begin  stlCode := Tstringlist.Create;  stlCode.LoadFromFile(downfilename);  edActCode.Text := copy(stlCode[3], pos('"="', stlCode[3]) + 3,    length(stlCode[3]) - pos('"="', stlCode[3]) - 3);end;procedure TfrmMain.btnReceiveClick(Sender: TObject);var  FTP_ptoclose, FTP_user, FTP_psw, FTP_svrip, FTP_path: string;  ls_user, ls_psw, ls_svrip, ls_path, ls_ptoclose: string;  i, j: Longint;  FDetail: FileRec;  stl, strlist: Tstringlist;  ftppath: string;  // ftp协议procedure P_ChangeDir(Dir: String);  begin    // 清空列表    strlist := Tstringlist.Create;    strlist.Clear;    IdFTP1.ChangeDir(Dir);    IdFTP1.List(strlist);    if strlist.Count > 0 then      if AnsiPos('total', strlist.Strings[0]) > 0 then        strlist.Delete(0);    ftppath := IdFTP1.RetrieveCurrentDir;  end; Procedure p_connect(subfolder: string);  begin    try      ls_ptoclose := FTP_ptoclose;      ls_user := FTP_user;      ls_psw := FTP_psw; // 不解密      ls_svrip := FTP_svrip;      ls_path := FTP_path + subfolder;    finally      // upini.Free;    end;    with IdFTP1 do      try        Username := ls_user;        Password := ls_psw;        Host := ls_svrip;        try          Note.Lines.Add('开始连接ftp服务器...');          Connect;        except          on E: Exception do          begin            Update;            Application.ProcessMessages;            Note.Lines.Add('连接失败.[' + E.Message + '],! ');            // Off automatically after 5 seconds..          end;        end;      finally        if Connected then        begin          Note.Lines.Add('连接成功，正在下载激活档');          P_ChangeDir(FTP_path);        end      end;  end;// 尝试主动作begin  if cbFtpList.Text = 'Ftp://[e-mail]/' then  begin    FTP_ptoclose := 'PalPCB';    FTP_user := 'PalPCB';    FTP_psw := 'palpilot1#';    FTP_svrip := '211.22.10.210';    FTP_path := '/PalPCB/Key';  end;  p_connect('');  if not(IdFTP1.Connected) then  exit;  if not DirectoryExists(downloadpath) then     ForceDirectories(downloadpath);  if fileexists(downfilename) then     deletefile(downfilename);  P_ChangeDir(FTP_path);  BytesToTransfer := IdFTP1.Size(FTP_path + '/' + rdCid.Text + '.reg');  IdFTP1.Get(rdCid.Text + '.reg', downfilename, false);  Application.ProcessMessages;  Note.Lines.Add(downfilename + ' ==> 文件已下载!');  IdFTP1.Quit;  Application.ProcessMessages;  getActCode;end;procedure TfrmMain.btnActClick(Sender: TObject);var  S: string;begin  S := 'C:\PalPCB\Allegro\pcbenv\' + rdCid.Text + '.reg';  ShellExecute(handle, 'open', 'regedit.exe', Pchar(S), '', SW_HIDE);end;