config.pas

最好的局域网搜索软件

unit Config;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Buttons, ExtCtrls, Spin,CommCtrl;

type
  TConfigForm = class(TForm)
    SpeedButton1: TSpeedButton;
    ConfigPageCtrl: TPageControl;
    FilterTabSheet: TTabSheet;
    BtnAddFilter: TSpeedButton;
    Label1: TLabel;
    BtnDelFilter: TSpeedButton;
    EditFilter: TEdit;
    CheckBox1: TCheckBox;
    ConfigTabSheet: TTabSheet;
    Bevel2: TBevel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    RadioGroup1: TRadioGroup;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    UserTabSheet: TTabSheet;
    GroupBox1: TGroupBox;
    Label7: TLabel;
    edtDftUser: TEdit;
    Label8: TLabel;
    edtDftPass: TEdit;
    btnChangeDft: TButton;
    btnSaveDft: TButton;
    Label6: TLabel;
    lvMountList: TListView;
    edtHost: TEdit;
    edtUser: TEdit;
    edtPass: TEdit;
    btnSave: TButton;
    btnChange: TButton;
    btnDelete: TButton;
    btnAdd: TButton;
    FilterPageCtrl: TPageControl;
    DestTabSheet: TTabSheet;
    DestListBox: TListBox;
    Mp3FilterTabSheet: TTabSheet;
    Mp3ListBox: TListBox;
    MovieDestTabSheet: TTabSheet;
    MovieListBox: TListBox;
    FtpTabSheet: TTabSheet;
    cbNoPass: TCheckBox;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    edtFtpUsr: TEdit;
    edtFtpPass: TEdit;
    btnChangeFtp: TButton;
    btnSaveFtp: TButton;
    Label11: TLabel;
    lvFtpMountList: TListView;
    edtFtpHost: TEdit;
    edtFtpUser: TEdit;
    edtPassFtp: TEdit;
    btnFtpSave: TButton;
    btnFtpChange: TButton;
    btnFtpDelete: TButton;
    btnFtpAdd: TButton;
    cbFtpRecursive: TCheckBox;
    Bevel1: TBevel;
    procedure BtnAddFilterClick(Sender: TObject);
    procedure FilterPageCtrlChange(Sender: TObject);
    procedure BtnDelFilterClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure btnChangeDftClick(Sender: TObject);
    procedure btnSaveDftClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnChangeClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnChangeFtpClick(Sender: TObject);
    procedure btnSaveFtpClick(Sender: TObject);
    procedure btnFtpAddClick(Sender: TObject);
    procedure btnFtpDeleteClick(Sender: TObject);
    procedure btnFtpChangeClick(Sender: TObject);
    procedure btnFtpSaveClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    CurFilterList:TListBox;
    BakUser, BakPass: string;
    BakFtpUser, BakFtpPass: string;
  public
    { Public declarations }
    SharePassList, FtpPassList: TStringList;
    function CheckDest(s: string):boolean;
    function CheckMP3(s: string):boolean;
    function CheckMovie(s: string):boolean;
    procedure GiveUserPassWord(Host: string; var User: string; var PassWord: string);
    procedure GiveFtpUserPassWord(Host: string; var User: string; var PassWord: string);
    procedure LoadFilter;
    procedure SaveFilter;
  end;

type
   TCPUID  = array[0..15] of byte;

var
  ConfigForm: TConfigForm;

implementation
uses Main, FmxUtils;
{$R *.DFM}

function GetCPUID : TCPUID; assembler; register;     //得到CPU序列号
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD		      {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI	      {Restore registers}
  POP     EBX
end;

function GetHDNumber(Drv : String): DWORD; //得到硬盘序列号
var
  VolumeSerialNumber : DWORD;
  MaximumComponentLength : DWORD;
  FileSystemFlags : DWORD;
begin

  if Drv[Length(Drv)] =':' then Drv := Drv + '\';
  GetVolumeInformation(pChar(Drv),
                       nil,
                       0,
                       @VolumeSerialNumber,
                       MaximumComponentLength,
                       FileSystemFlags,
                       nil,
                       0);
  Result:= (VolumeSerialNumber);

end;

function encode(str: string): string;
const
  NO_CPU_ID: TCPUID = (1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6);
  SERAIL_NUM: array[0..3] of byte = ($a, $b, $c, $d);
var
  CpuId: TCPUID;
  list: array of byte;
  s: string;
  len, i: integer;

  vs: DWORD;
  vs_list: array[0..3] of byte;
begin
  try CpuId := GetCPUID except on EExternalException  do
    CpuId :=  NO_CPU_ID;
  end;

  try vs := GetHDNumber('c:/') except on EExternalException  do
    CopyMemory(@vs, @SERAIL_NUM[0], 4);
  end;
  CopyMemory(@vs_list[0], @vs, 4);

  len := length(str);
  SetLength(list, len);
  for i := 0 to len-1 do
  begin
    list[i] := byte(str[i+1]) xor CpuId[i mod 16] xor vs_list[i mod 4];
  end;

  s := '';
  for i := 0 to len-1 do
  begin
    s := s + format('%.2x', [list[i]]);
  end;
  result := s;
end;

function decode(str: string): string;
const
  NO_CPU_ID: TCPUID = (1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6);
  SERAIL_NUM: array[0..3] of byte = ($a, $b, $c, $d);
var
  CpuId: TCPUID;
  list: array of byte;
  s, ss: string;
  len, i: integer;

  vs: DWORD;
  vs_list: array[0..3] of byte;
begin
  try CpuId := GetCPUID except on EExternalException  do
    CpuId :=  NO_CPU_ID;
  end;

  try vs := GetHDNumber('c:/') except on EExternalException  do
    CopyMemory(@vs, @SERAIL_NUM[0], 4);
  end;
  CopyMemory(@vs_list[0], @vs, 4);

  len := length(str) div 2;
  SetLength(list, len);
  i := 0;

  while(length(str)>0) do
  begin
    s := copy(str, 1, 2);
    //ShowMessage(s);
    if i > len then
    begin
      ShowMessage('读入密码出错1：'+str);
      result := '';
      exit;
    end;
    try
      list[i] := strtoint('$'+s);
      except on EConvertError do
      begin
        ShowMessage('读入密码出错2：'+str);
        result := '';
        exit;
      end;
    end;
    inc(i);
    delete(str, 1, 2);
  end;

  if i <> len then
  begin
    ShowMessage(format('读入密码出错3：%s,%d,%d',[str, i, len]));
    result := '';
    exit;
  end;

  //ShowMessage(format('%x,%x,%x,%x,%x',[list[0], list[1], list[2], list[3], list[4]]));

  SetLength(ss, len);
  for i := 0 to len-1 do
  begin
    ss[i+1] := char(byte(list[i mod 16]) xor CpuId[i mod 16] xor vs_list[i mod 4]);
  end;

  result := ss;
end;

function Pass2Star(s: string): string;
var
  star: string;
  i, len: integer;
begin
  len := length(s);
  star := '';
  for i := 1 to len do star := star + '*';
  result := star;
end;

procedure PassMount(s: string; var s1, s2, s3: string);
var
  i: integer;
begin

  //ShowMessage('|'+s+'|'); ///
  s1 := '';
  s2 := '';
  s3 := '';

  i := pos(#9, s);
  s1 := copy(s, 1, i-1);
  delete(s, 1, i);

  //ShowMessage('|'+s+'|'); ///

  i := pos(#9, s);
  if i <> 0 then
  begin
    s2 := copy(s, 1, i-1);
    delete(s, 1, i);

    s3 := s;
  end
  else
  begin
    s2 := s;
    s3 := '';
  end;

  //ShowMessage(format('|%s:%s:%s|', [s1, s2, s3])); ///
end;

procedure TConfigForm.LoadFilter;
var
  f: TextFile;
  s: string;
  t: integer;
  s1, s2, s3: string;
  item: TListItem;
begin
  if FileExists('config.log') then
  begin
    t := 0;
    AssignFile(f, 'config.log');
    Reset(f);

    while not eof(f) do
    begin
      readln(f, s);

      s := trim(s);
      if s = '' then continue;
      
      if s = '[custom filter]' then t := 0
      else if s = '[music filter]' then t := 1
      else if s = '[movie filter]' then t := 2
      else if s = '[share mount]' then t := 3
      else if s = '[ftp mount]' then t := 4
      else
      begin
        if t = 0 then
        begin
          if DestListBox.Items.IndexOf(s) = -1 then DestListBox.Items.Add(s);
        end
        else if t = 1 then
        begin
          if Mp3ListBox.Items.IndexOf(s) = -1 then Mp3ListBox.Items.Add(s)
        end
        else if t = 2 then
        begin
          if MovieListBox.Items.IndexOf(s) = -1 then MovieListBox.Items.Add(s);
        end
        else if t = 3 then
        begin
          PassMount(s, s1, s2, s3);
          item := lvMountList.Items.Add;
          item.Caption := s1;
          item.SubItems.Add(s2);
          item.SubItems.Add(Pass2Star(decode(s3)));
          SharePassList.Add(decode(s3));
        end
        else if t = 4 then
        begin
          PassMount(s, s1, s2, s3);
          item := lvFtpMountList.Items.Add;
          item.Caption := s1;
          item.SubItems.Add(s2);
          item.SubItems.Add(Pass2Star(decode(s3)));
          FtpPassList.Add(decode(s3));
        end
      end;
    end;

    CloseFile(f);
  end;
end;

procedure TConfigForm.SaveFilter;
var
  f: TextFile;
  i: integer;
begin

  AssignFile(f, AppDir + '\config.log');
  ReWrite(f);

  writeln(f, '[custom filter]');
  for i:=0 to (DestListBox.Items.Count-1) do writeln(f, DestListBox.Items[i]);

  writeln(f, '[music filter]');
  for i:=0 to (Mp3ListBox.Items.Count-1) do writeln(f, Mp3ListBox.Items[i]);

  writeln(f, '[movie filter]');
  for i:=0 to (MovieListBox.Items.Count-1) do writeln(f, MovieListBox.Items[i]);

  writeln(f, '[share mount]');
  for i:=0 to (lvMountList.Items.Count-1) do
  begin
    write(f, lvMountList.Items[i].Caption + #9);
    write(f, lvMountList.Items[i].SubItems[0] + #9);
    //writeln(f, encode(lvMountList.Items[i].SubItems[1]));
    writeln(f, encode(SharePassList.Strings[i]));
  end;

  writeln(f, '[ftp mount]');
  for i:=0 to (lvFtpMountList.Items.Count-1) do
  begin
    write(f, lvFtpMountList.Items[i].Caption + #9);
    write(f, lvFtpMountList.Items[i].SubItems[0] + #9);
    //writeln(f, encode(lvFtpMountList.Items[i].SubItems[1]));
    writeln(f, encode(FtpPassList.Strings[i]));
  end;

  CloseFile(f);

end;

procedure TConfigForm.GiveUserPassWord(Host: string; var User: string; var PassWord: string);
var
  i: integer;
  s: string;
begin

  if edtDftUser.Color = clWhite then
  begin