umain.~pas

DELPHI DFM资源文件内码批量转换程序

unit uMain;

interface

uses
  Windows, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, StdCtrls, ExtCtrls, Menus, RzSndMsg, RzForms, Contnrs,
  RzLaunch, RzShellDialogs, DB, ADODB, uComFun;

type
  TfrmMain = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tbSelDir: TToolButton;
    tbSelFile: TToolButton;
    ToolButton3: TToolButton;
    tbCovDFM: TToolButton;
    tbCovPas: TToolButton;
    ToolButton6: TToolButton;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    Splitter3: TSplitter;
    Panel1: TPanel;
    Splitter4: TSplitter;
    GroupBox1: TGroupBox;
    memDest: TMemo;
    Splitter5: TSplitter;
    Splitter6: TSplitter;
    Splitter7: TSplitter;
    GroupBox2: TGroupBox;
    Splitter8: TSplitter;
    Splitter9: TSplitter;
    Splitter10: TSplitter;
    memSrc: TMemo;
    ToolButton7: TToolButton;
    PopMenu: TPopupMenu;
    miBinToText: TMenuItem;
    miNumToCode: TMenuItem;
    miShowTrue: TMenuItem;
    N2: TMenuItem;
    miToBak: TMenuItem;
    miToNew: TMenuItem;
    OpenDialog: TOpenDialog;
    N1: TMenuItem;
    miGBKSToT: TMenuItem;
    miBigToGBK: TMenuItem;
    RzLch: TRzLauncher;
    RzSendMessage1: TRzSendMessage;
    N3: TMenuItem;
    miSeldfm: TMenuItem;
    miSelpas: TMenuItem;
    miNotCovert: TMenuItem;
    Panel2: TPanel;
    lstBox: TListBox;
    Splitter11: TSplitter;
    SaveDlg: TSaveDialog;
    lstFailBox: TListBox;
    tbModFont: TToolButton;
    N4: TMenuItem;
    miCovFont1: TMenuItem;
    miCovCharset: TMenuItem;
    miH11toH13: TMenuItem;
    RzSelDirDlg: TRzSelectFolderDialog;
    PopupMenu1: TPopupMenu;
    MenuItem18: TMenuItem;
    MenuItem19: TMenuItem;
    miCovToParent: TMenuItem;
    miShowCovFont: TMenuItem;
    tbModExt: TToolButton;
    miSelNew: TMenuItem;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    DFM1: TMenuItem;
    PAS1: TMenuItem;
    N5: TMenuItem;
    New1: TMenuItem;
    tbAnsiToGB: TMenuItem;
    N6: TMenuItem;
    DFMPas1: TMenuItem;
    ADOC1: TADOConnection;
    miUnknowEvent: TMenuItem;
    miAutoCovClass: TMenuItem;
    ADOQryEvent: TADOQuery;
    ADOQryClass: TADOQuery;
    ADOQry: TADOQuery;
    miUnKnowClass: TMenuItem;
    procedure DFMPas1Click(Sender: TObject);
    procedure Splitter2CanResize(Sender: TObject; var NewSize: Integer;
      var Accept: Boolean);
    procedure tbSelDirClick(Sender: TObject);
    procedure tbCovDFMClick(Sender: TObject);
    procedure tbSelFileClick(Sender: TObject);
    procedure tbCovPasClick(Sender: TObject);
    procedure lstBoxDblClick(Sender: TObject);
    procedure lstFailBoxDblClick(Sender: TObject);
    procedure tbModFontClick(Sender: TObject);
    procedure MenuItem19Click(Sender: TObject);
    procedure MenuItem18Click(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure tbModExtClick(Sender: TObject);
    procedure tbAnsiToGBClick(Sender: TObject);
  private
    procedure FindFile(ASourceDir, AExtName: string);
    function BStrPos(Str, StrSub: string; L1, L2: Integer): Integer;
  protected
    function AddCovClass(Query: TAdoQuery; const ClassName, CovClass: string; const
      UseUnit: TStringList = nil; const IsUser: Boolean = True): Boolean;
    function AddEvent(Query: TAdoQuery; const ClassName, EventName, Param: string;
      IsUser: Boolean): Boolean;
    procedure CodeConvert(input, output: TMemoryStream; CovType: Integer);
    procedure CodeCovAnsiTOGB(input, output: TMemoryStream; Findex: integer);
    procedure CodeCovFont(input, output: TMemoryStream; Findex: integer);
    procedure CodeGetObjectDef(var input: TMemoryStream; output: TStrings; const
      SrcFileName: string);
    { Private declarations }
    procedure CodeNumToStr(input, output: TMemoryStream);
    function GetLastString(AStrList: TStringList; Count: Integer): string;
    function HasCovClass(var Query: TAdoQuery; ClassName: string; var CovClass:
      string; const UseUnit: TStringList): Boolean;
    function HasEvent(var Query: TAdoQuery; const ClassName, EventName: string; var
      Param: string): Boolean;
  public
    { Public declarations }
  end;


var
  frmMain: TfrmMain;

implementation

{$R *.dfm}
const
  ConnString: string = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False';

function TfrmMain.AddEvent(Query: TAdoQuery; const ClassName, EventName, Param:
  string; IsUser: Boolean): Boolean;
var
  sSql: string;
begin
  Result := false;
  //
  sSQL := ForMat('Insert into EventList (ClassName,EventName,EventParamDef,IsUse,InTime) Values ' +
    '(''%s'',''%s'',''%s'',%s,''%s'')',
    [ClassName, EventName, Param, BoolToStr(IsUser, True), FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
  Result := ExecSQL(Query, sSql);
  //if Result then ADOQryEvent.Refresh;  
end;

function TfrmMain.AddCovClass(Query: TAdoQuery; const ClassName, CovClass:
  string; const UseUnit: TStringList = nil; const IsUser: Boolean = True):
  Boolean;
var
  sSql: string;
  sUseUnit: string;
begin
  Result := false;
  sUseUnit := '';
  if Assigned(UseUnit) then
  begin
    sUseUnit := StringReplace(UseUnit.Text, #13#10, ',', [rfReplaceAll]);
  end;
  //
  sSQL := ForMat('Insert into ClassList (ClassName,CovClassName,UseUnit,IsUse,InTime) Values ' +
    '(''%s'',''%s'',''%s'',%s,''%s'')',
    [ClassName, CovClass, sUseUnit, BoolToStr(IsUser, True), FormatDateTime('yyyy-mm-dd hh:nn:ss', Now)]);
  Result := ExecSQL(Query, sSql);
  //if Result then ADOQryClass.Refresh;
end;

function TfrmMain.HasEvent(var Query: TAdoQuery; const ClassName, EventName:
  string; var Param: string): Boolean;
var
   sSQL:String;
begin
  Result := False;
  Param := '(Sender:TObject)';
  if not Assigned(Query) then exit;
  sSQL:=ForMat('select * from EventList '+
     'where IsUse=True and Ucase(ClassName)=Ucase(''%s'') and Ucase(EventName)=Ucase(''%s'')',[ClassName,EventName]);
  if (EventName='OnClose') then
     ShowMessage(EventName);
  ActiveSQL(Query,sSQL);
  if ((Query.Active) and (Query.RecordCount>0)) then
  try
    Param :=Query.FieldByName( 'EventParamDef').AsString;;
    Result:=True;
  except
  end;
end;

function TfrmMain.BStrPos(Str, StrSub: string; L1, L2: Integer): Integer;
var
  M1, M2: integer;
  bM1, bM2: char;
  //label GoHere;
begin
  Result := 0;
  if (L1 < L2) then Exit;
  M1 := 1;
  while ((L1 - M1 + 1) >= L2) do
  begin
    M2 := 1;
    while (M2 <= L2) do
    begin
      bM1 := Str[M1 + M2 - 1];
      bM2 := StrSub[M2];
      if (bM1 <> bM2) then
      begin
        M2 := M2;
        Break;
      end;
      inc(M2);
    end;
    //
    if (M2 > L2) then
    begin
      Result := M1;
      Exit;
    end;
    inc(M1);
  end;
end;


procedure TfrmMain.Splitter2CanResize(Sender: TObject; var NewSize: Integer;
  var Accept: Boolean);
begin
  Accept := False;
end;

procedure TfrmMain.tbSelDirClick(Sender: TObject);
var
  sPath, sExtName: string;
begin
  if (RzSelDirDlg.Execute) then
  begin
    sPath := RzSelDirDlg.SelectedPathName;
    if (RightStr(sPath, 1) <> '\') then sPath := sPath + '\';
    if (miSelPas.Checked) then
      sExtName := '.pas'
    else if (miSelDfm.Checked) then
      sExtName := '.dfm'
    else
      sExtName := '.new';
    lstBox.Clear;
    FindFile(sPath, sExtName);
    {with lstBox do
    begin
      if FindFirst(sFindFile, FileAttrs, SRec) = 0 then
      begin
        repeat
          if (SRec.Attr and FileAttrs) = SRec.Attr then
            lstBox.Items.Add(sPath + SRec.Name);
        until FindNext(SRec) <> 0;
        FindClose(SRec);
      end;
    end;}
  end;
end;

procedure TfrmMain.CodeNumToStr(input, output: TMemoryStream);
var
  SaveSeparator: Char;
  Parser: TParser;
  iSize, iSrcLen, iDestLen: integer;
  sTmp: string;
  wsSrc, wsDest: WideString;
begin
  input.Seek(0, soFromBeginning);
  output.LoadFromStream(input);
  input.Seek(0, soFromBeginning);
  Parser := TParser.Create(input);
  SaveSeparator := DecimalSeparator;
  DecimalSeparator := '.';
  try
    //InheritedObject := False;
    //InlineObject := False;
    iSize := input.Size;
    while ((Parser.SourcePos < iSize) and (Parser.Token <> toEof)) do
    begin
      if (Parser.Token = toWString) then
      begin
        wsSrc := Parser.TokenString;
        wsDest := QuotedStr(Parser.TokenWideString);
        iSrcLen := CharToByteLen(wsSrc, Length(wsSrc));
        iDestLen := CharToByteLen(wsDest, length(wsDest));
        output.Position := Parser.SourcePos;
        if (iSrcLen >= iDestLen) then
        begin
          sTmp := wsDest + DupeString(' ', iSrcLen - iDestLen);
          output.Write(sTmp[1], charToByteLen(sTmp, Length(sTmp)));
        end else
        begin
          lstFailBox.Items.Add(wsSrc);
          //MemDest.Lines.Add(wsSrc);
        end;
      end;
      Parser.NextToken;
    end;
    output.Seek(0, soFromBeginning);
  finally
    DecimalSeparator := SaveSeparator;
    FreeAndNil(Parser);
  end;
end;

procedure TfrmMain.tbCovDFMClick(Sender: TObject);
const
  sBinHead: string = #255#10#00;
  sTxtStarHead: Pchar = 'TPF0'#0;
var
  //fsIn:TFileStream;
  msIn, msTmp: TMemoryStream;
  index, iCovType: Integer;
  sSrcTxt, sDestTxt, sHead: string;
  pcFirst: Integer;
  {fmCreate,fmOpenRead,fmOpenWrite,fmOpenReadWrite}
begin
  msIn := TMemoryStream.Create();
  msTmp := TMemoryStream.Create();
  lstFailBox.Clear;
  try
    for index := 0 to lstBox.Count - 1 do
    begin
      try
        msIn.Clear;
        msTmp.Clear;
        msIn.LoadFromFile(lstBox.Items[index]);
        msIn.Seek(0, soFromBeginning);
        SetLength(sHead, 51);
        msIn.Read(sHead[1], 50);
        if ((LeftBStr(sHead, 3) = sBinHead) and (miBinToText.Checked)) then
        begin
          msTmp.Clear;
          pcFirst := BStrPos(sHead, sTxtStarHead, 50, 4);
          if (pcFirst <> 0) then
          begin
            msIn.Position := pcFirst - 1;
            ObjectBinaryToText(msIn, msTmp);
            msIn.Clear; msTmp.Seek(0, soFromBeginning);
            msIn.LoadFromStream(msTmp);
          end else
          begin
            raise Exception.Create('二进制资源文件匹配错误！');
          end;
        end;
        msIn.Seek(0, soFromBeginning);
        memSrc.Lines.LoadFromStream(msIn);
        if (miNumToCode.Checked) then
        begin
          msTmp.Clear;
          CodeNumToStr(msIn, msTmp);
          msIn.Clear; msTmp.Seek(0, soFromBeginning);
          msIn.LoadFromStream(msTmp);
        end;
        msIn.Seek(0, soFromBeginning);

        if (not miNotCovert.Checked) then
        begin
          msTmp.Clear;
          if (miGBKSToT.Checked) then
            iCovType := 1
          else
            iCovType := 2;
          CodeConvert(msIn, msTmp, iCovType);
          msIn.Clear; msTmp.Seek(0, soFromBeginning);
          msIn.LoadFromStream(msTmp);
        end;

        memDest.Clear;
        memDest.Lines.LoadFromStream(msIn);
        if ((not miShowTrue.Checked) or
          (Application.MessageBox('你是否确定要转换!',
          '系统提示', MB_YESNO) = IDYES)) then
        begin
          if (miToBak.Checked) then
          begin
            sSrcTxt := lstBox.Items[index];
            sDestTxt := sSrcTxt + '.Bak';
            CopyFile(PAnsiChar(sSrcTxt), PAnsiChar(sDestTxt), LongBool(0));
            msIn.SaveToFile(sSrcTxt);
          end else
          begin
            sSrcTxt := lstBox.Items[index];
            sDestTxt := sSrcTxt + '.New';
            msIn.SaveToFile(sDestTxt);
          end;
        end;
      except
        lstFailBox.Items.Add(lstBox.Items[index]);
      end;
    end;
  finally
    FreeAndNil(msIn);
    FreeAndNil(msTmp);
  end;
end;
//

procedure TfrmMain.tbSelFileClick(Sender: TObject);
begin
  if (miSelPas.Checked) then
    OpenDialog.FilterIndex := 1
  else
    OpenDialog.FilterIndex := 2;
  if (OpenDialog.Execute) then
  begin
    lstBox.Clear;
    lstBox.Items.Add(OpenDialog.FileName);
  end;
end;
//

procedure TfrmMain.CodeConvert(input, output: TMemoryStream; CovType: Integer);
const
  sSrc = 'Src.tmp';
  sDest = 'Dest.tmp';
  sType1Comline = '/i:gbk /o:gbk /f:s ';
  sType2Comline = '/i:big5 /o:gbk	/f:s ';
var
  sPath: string;
  sFileSrc, sFileDest: string;
begin
  sPath := ExtractFilePath(Application.ExeName);
  if (RightStr(sPath, 1) <> '\') then sPath := sPath + '\';
  sFileSrc := sPath + sSrc;
  sFileDest := sPath + sDest;
  input.SaveToFile(sFileSrc);
  if (CovType = 2) then
    RzLch.Parameters := sType2Comline + sFileSrc + ' ' + sFileDest
  else
    RzLch.Parameters := sType1Comline + sFileSrc + ' ' + sFileDest;
  RzLch.Launch;
  output.Clear;
  output.LoadFromFile(sFileDest);
end;

procedure TfrmMain.tbCovPasClick(Sender: TObject);
const
  sBinHead: string = #255#10#00;
var
  msIn, msTmp: TMemoryStream;
  index, iCovType: Integer;
  sSrcTxt, sDestTxt: string;