main.pas

1.简繁相互转换 2.文件批量处理 3.可直接转换数据库字段

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, DB, MemTableEh, GridsEh, DBGridEh, SFolders,
  ADODB, ExtCtrls, ComCtrls;

type
  TfrmMain = class(TForm)
    Mem: TMemTableEh;
    DataSource1: TDataSource;
    MemFileName: TStringField;
    MemFullPath: TStringField;
    SearchFolders1: TSearchFolders;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    DBGridEh1: TDBGridEh;
    Panel1: TPanel;
    Splitter1: TSplitter;
    memoSinleFile: TMemo;
    btnOpenSingFile: TButton;
    btnTransitionSingle: TButton;
    btnSaveSingle: TButton;
    MemSubDir: TStringField;
    Panel2: TPanel;
    Label1: TLabel;
    edtSourceDir: TEdit;
    btnOpenDir: TButton;
    btnSearch: TButton;
    Label2: TLabel;
    edtDeDir: TEdit;
    btnOpenDeDir: TButton;
    btnTraDir: TButton;
    Splitter2: TSplitter;
    Panel3: TPanel;
    btnOpenData: TButton;
    DBGridEh2: TDBGridEh;
    MemTableName: TMemTableEh;
    dsTableName: TDataSource;
    btnDataTran: TButton;
    MemTableNameIsSelected: TBooleanField;
    MemTableNameName: TStringField;
    MemIsSelected: TBooleanField;
    btnAll: TButton;
    btnClear: TButton;
    btnSingleBig5ToGB: TButton;
    btnDirBig5ToGB: TButton;
    btnDataBig5ToGB: TButton;
    btnDataAll: TButton;
    btnDataClear: TButton;
    TabSheet4: TTabSheet;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    edtMac: TEdit;
    edtReg: TEdit;
    btnReg: TButton;
    cbInt: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure SearchFolders1Changed(Sender: TObject; CountFiles,
      SizeOfFiles: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure btnOpenSingFileClick(Sender: TObject);
    procedure btnTransitionSingleClick(Sender: TObject);
    procedure btnSaveSingleClick(Sender: TObject);
    procedure btnOpenDirClick(Sender: TObject);
    procedure btnSearchClick(Sender: TObject);
    procedure btnOpenDeDirClick(Sender: TObject);
    procedure btnTraDirClick(Sender: TObject);
    procedure btnOpenDataClick(Sender: TObject);
    procedure btnDataTranClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnAllClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure btnSingleBig5ToGBClick(Sender: TObject);
    procedure btnDirBig5ToGBClick(Sender: TObject);
    procedure btnDataBig5ToGBClick(Sender: TObject);
    procedure btnDataAllClick(Sender: TObject);
    procedure btnDataClearClick(Sender: TObject);
    procedure btnRegClick(Sender: TObject);
  private
    { Private declarations }
    sVolumn: string;
    m_bPas: Boolean;
    m_sExt: string;
    m_bReg: Boolean;
    m_sMac: string;
    function EncSong(sFileName, dFileName, PassWord: string): boolean;
    function UnEncSong(sFileName, dFileName,
      PassWord: string): boolean;
    function HasGBCode(var Str: string): Boolean;
    function HasBig5Code(var Str: string): Boolean;
    function DfmToBig5(Str: string): string;
    function DfmToGB(Str: string): string;
    function GetMacCode: string;
    function GetRegCode(Str: string): string;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses genFunc, MpgUtil, StrUtils, Registry;

{$R *.dfm}

procedure TfrmMain.Button1Click(Sender: TObject);
var
  sTemp: string;

begin
  SearchFolders1.FileMask := '*.wmv,*.mpg,*.VOB,*.dat';
  SearchFolders1.ScanOptions := soSpecifiedDir;
  //SearchFolders1.ScanDir := DirectoryListBox1.Directory;
  //sVolumn := DiskVolume(DirectoryListBox1.Directory);
//  if sVolumn='' then
//  begin
//    Application.MessageBox(PChar('请设置搜索盘卷标！'),PChar('警告'),MB_OK+MB_ICONWARNING);
//    Exit;
//  end;
//  SearchFolders1.Scan;
end;

procedure TfrmMain.SearchFolders1Changed(Sender: TObject; CountFiles,
  SizeOfFiles: Integer);
var
  iCount, ii, i, iLen: Integer;
  fp: TFilePack;
  sTemp: string;
begin
  iLen := Length(Trim(edtSourceDir.Text));
  iCount := SearchFolders1.FilesFound.Count;
  if iCount = 0 then
  begin
    Exit;
  end;
  Screen.Cursor := crHourGlass;
  while Mem.RecordCount > 0 do
  begin
    Mem.Delete;
  end;
  for ii := 0 to iCount - 1 do
  begin
    fp := TFilePack(SearchFolders1.FilesFound[ii]);
    Mem.Append;
    MemIsSelected.AsBoolean := True;
    MemFileName.AsString := fp.FileName;
    MemFullPath.AsString := fp.FullPath;
    sTemp := Copy(fp.FullPath, iLen + 1, Length(fp.FullPath) - iLen - 1);
//    if ADOQuery1.Locate('SongNum', sTemp, [loCaseInsensitive]) then
//    begin
//      ADOQuery1.Edit;
//      ADOQuery1.FieldByName('SourceNo').AsString := sVolumn;
//      ADOQuery1.Post;
//      //MemVolumn.AsString := sVolumn;
//    end;
    MemSubDir.AsString := sTemp;
    Mem.Post;
  end;
  Screen.Cursor := crDefault;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  Reg: TRegistry;
  sTemp: string;
begin
  m_bReg := False;
  Self.Caption := '简繁转换器（未注册）';
  m_sMac := GetMacCode;
  edtMac.Text := m_sMac;
  Reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\LXSoftware', True);
  if (reg.ValueExists('LXRegCode')) then
  begin
    sTemp := Reg.ReadString('LXRegCode');
    if sTemp = GetRegCode(m_sMac) then
    begin
      m_bReg := True;
      Self.Caption := '简繁转换器（已注册）';
    end;
  end
  else
  begin
    Reg.WriteString('LXRegCode', m_sMac);
  end;
  Reg.Free;
  PageControl1.ActivePageIndex := 0;
end;

function TfrmMain.UnEncSong(sFileName, dFileName,
  PassWord: string): boolean;
begin
  Result := false;
  if StreamUnEncrypt(sFileName, dFileName, PassWord) = 1 then
  begin
    Result := true;
  end; //if
//  case StreamUnEncrypt(sFileName, dFileName, PassWord) of
//    -1: memo1.Lines.Add(sFileName + '文件没有加密');
//    0: Memo1.Lines.Add(sFileName + '文件解码错误，请输入正确密码!');
//    1:
//      begin
//        Memo1.Lines.Add(sFileName + '文件解码成功，存盘文件为：' + dFileName);
//        Result := true;
//      end;
//  end;
end;


function TfrmMain.EncSong(sFileName, dFileName, PassWord: string): boolean;
begin
  Result := false;
  if FileExists(sFileName) = false then exit;

  if GetStreamPass(sFileName) >= 0 then
  begin
//    Memo1.Lines.Add(sFileName + '文件已经copy不成功!');
    exit; ////返回-1：没有加密，返回0：加密，密码错误 返回1：密码正确
  end;

  StreamEncrypt(sFileName, dFileName, PassWord);
//  if isVCDFile(sFileName) then
//  begin //如果是vcd文件,就把它转成mpeg1 并加密
//    if Vcd2Mpg(sFileName, dFileName, PassWord) then
//      Memo1.Lines.Add(sFileName + '文件COPY成功,存盘文件为' + dFileName);
//  end
//  else
//  begin
//    if  then
//      Memo1.Lines.Add(sFileName + '文件copy成功,存盘文件为' + dFileName);
//  end;
  Result := true;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
var
  sPass: string;
  sPath: string;
begin
//  if Mem.RecordCount>0 then
//  begin
//    Mem.First;
//    sPass:= 'www.xdlvod.com';
//    sPath:=Edit1.Text;
//    while not Mem.Eof do
//    begin
//      unEncSong(MemFullPath.AsString+MemFileName.AsString,sPath+MemFileName.AsString,sPass );
//      Mem.Next;
//    end; //while
//  end; //if
end;

procedure TfrmMain.btnOpenSingFileClick(Sender: TObject);
begin
  with TOpenDialog.Create(Application) do
  begin
    Filter := '文本文件|*.html;*.php;*.asp;*.aspx;*.cpp;*.h;*.cs;*.pas;*.dfm;*.ini;*.txt';
    if Execute then
    begin
      m_sExt := ExtractFileExt(FileName);
      m_bPas := m_sExt <> '.dfm';

      memoSinleFile.Clear;
      memoSinleFile.Lines.LoadFromFile(FileName);
    end;
    Free;
  end;
end;

procedure TfrmMain.btnTransitionSingleClick(Sender: TObject);
var
  i: Integer;
  sList: TStrings;
  stemp: string;
begin
  if memoSinleFile.Lines.Count = 0 then
  begin
    Exit;
  end;
  sList := TStringList.Create;
  for i := 0 to memoSinleFile.Lines.Count - 1 do
  begin
    if m_bPas then
    begin
      stemp := GBToBIG5(memoSinleFile.Lines[i]);
    end
    else
    begin
      stemp := DfmToBig5(memoSinleFile.Lines[i]);
    end;
    sList.Add(stemp);
  end;
  memoSinleFile.Clear;
  memoSinleFile.Lines.Assign(sList);
  sList.Free;
  memoSinleFile.Font.Charset := CHINESEBIG5_CHARSET;
  memoSinleFile.Font.Name := '细明体';
  Application.MessageBox(PChar('完成！'), PChar('提示'), MB_OK + MB_ICONINFORMATION);
end;

procedure TfrmMain.btnSaveSingleClick(Sender: TObject);
var
  sFileName: string;
begin
  with TSaveDialog.Create(Application) do
  begin
//    if m_bPas then
//    begin
//      Filter := 'Delphi文件(*.pas)|*.pas';
//    end
//    else
//    begin
//      Filter := 'Delphi文件(*.dfm)|*.dfm';
//    end;
    Filter := '文本文件|*' + m_sExt;
    if Execute then
    begin
      //memoSinleFile.Clear;
      sFileName := FileName;
      if not AnsiContainsText(FileName, m_sExt) then
      begin
        sFileName := FileName + m_sExt;
      end;
//      if m_bPas then
//      begin
//        if not AnsiContainsText(FileName, '.pas') then
//        begin
//          sFileName := FileName + '.pas';
//        end;
//      end
//      else
//      begin
//        if not AnsiContainsText(FileName, '.dfm') then
//        begin
//          sFileName := FileName + '.dfm';
//        end;
//      end;
      memoSinleFile.Lines.SaveToFile(sFileName);
    end;
    Free;
  end;
end;

function TfrmMain.DfmToBig5(Str: string): string;
var
  sTmp, sGB: string;
  i, j, iLen: Integer;
  sResult: string;
begin
  sTmp := Str;
  if AnsiContainsText(sTmp, 'Font.Charset') then
  begin
    i := Pos('F', sTmp);
    Result := Copy(sTmp, 1, i - 1) + 'Font.Charset = CHINESEBIG5_CHARSET';
    Exit;
  end
  else
    if AnsiContainsText(sTmp, 'Font.Name') then
    begin
      i := Pos('F', sTmp);
      Result := Copy(sTmp, 1, i - 1) + 'Font.Name = #32048#26126#39636';
      Exit;
    end
    else
    begin
      sResult := '';
      iLen := Length(sTmp);
      i := 1;
      while i <= iLen do
      begin
        if sTmp[i] = '#' then
        begin
          sResult := sResult + '#';
          for j := i + 1 to iLen do
          begin
            if not (sTmp[j] in ['0'..'9']) then
            begin
              Break;
            end;
          end;
          if j <= iLen + 1 then
          begin

            sGB := Copy(sTmp, i + 1, j - i - 1);
            if Trim(sGB) <> '' then
            begin
              if HasGBCode(sGB) then
              begin
                sResult := sResult + sGB;
              end
              else
              begin
                sResult := sResult + sGB;
              end;
            end;

            i := j;
          end
          else
          begin
            sResult := sResult + Copy(sTmp, i + 1, iLen - i);
            Result := sResult;
            Exit;
          end;
        end
        else
        begin
          sResult := sResult + sTmp[i];
          i := i + 1;
        end;
      end;
    end;
  Result := sResult;
end;

function TfrmMain.HasGBCode(var Str: string): Boolean;
var
  i: Integer;
  iLen: Integer;
begin
  Result := False;
  iLen := Length(Str);
  for i := 1 to iLen do
  begin
    if not (Str[i] in ['0'..'9']) then
    begin
      Exit;
    end;
  end;
  Str := GBUnicodeToBig5Unicode(Str);
  Result := True;
end;

procedure TfrmMain.btnOpenDirClick(Sender: TObject);
var
  sDir: string;
begin
  if SelectDirectory('选择源文件夹', '', sDir) then
  begin
    edtSourceDir.Text := sDir + '\';
  end;
end;

procedure TfrmMain.btnSearchClick(Sender: TObject);
begin
  if Trim(edtSourceDir.Text) = '' then
  begin
    Exit;
  end;
  SearchFolders1.FileMask := '*.html,*.php,*.asp,*.aspx,*.cpp,*.h,*.cs,*.pas,*.dfm,*.dpr,*.ini,*.txt';
  SearchFolders1.ScanOptions := soSpecifiedDir;
  SearchFolders1.ScanDir := edtSourceDir.Text;
  SearchFolders1.Scan;
end;

procedure TfrmMain.btnOpenDeDirClick(Sender: TObject);
var
  sDir: string;
begin
  if SelectDirectory('选择目标文件夹', '', sDir) then
  begin
    edtDeDir.Text := sDir + '\';
  end;
end;

procedure TfrmMain.btnTraDirClick(Sender: TObject);
var
  i, iCount: Integer;
  sList, sListDe: TStrings;
  stemp: string;
begin
  if Mem.RecordCount = 0 then
  begin
    Exit;
  end;
  Screen.Cursor := crHourGlass;
  sList := TStringList.Create;
  sListDe := TStringList.Create;
  Mem.First;
  iCount := 0;
  while not Mem.Eof do
  begin

    if MemIsSelected.AsBoolean then
    begin
      sList.Clear;
      sListDe.Clear;
      m_bPas := not AnsiContainsText(MemFileName.AsString, '.dfm');
      sList.LoadFromFile(MemFullPath.AsString + MemFileName.AsString);
      for i := 0 to sList.Count - 1 do
      begin
        if m_bPas then
        begin
//          if cbIntDir.Checked then