main_u.pas

全功能windows 资源编程器。 Delphi 编写 Windows 界面.

unit main_u;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls,shellapi, Spin, Grids, inifiles, ExtCtrls, Buttons,jpeg,
  mmsystem;

type
  TVersionNumber=array[1..4]of byte;
  TForm_RFEMain = class(TForm)
    Btn_LoadRC: TButton;
    Btn_Create: TButton;
    SB_Update: TSpeedButton;
    ListView1: TListView;
    CB_Type: TComboBox;
    Edit_Name: TEdit;
    Edit_Value: TEdit;
    Btn_LoadFile: TButton;
    Btn_Add: TButton;
    Btn_Del: TButton;
    ListBox1: TListBox;
    PageControl1: TPageControl;
      Tab_Options: TTabSheet;
        Lbl_Compiler: TLabel;
        Edit_Compiler: TEdit;
        Btn_ChooseCompiler: TButton;
        Lbl_Language: TLabel;
        CB_Language: TComboBox;
      Tab_VersionInfos: TTabSheet;
        GB_ProductVersion: TGroupBox;
          SpinEdit1: TSpinEdit;
          SpinEdit2: TSpinEdit;
          SpinEdit3: TSpinEdit;
          SpinEdit4: TSpinEdit;
        GB_FileVersion: TGroupBox;
          SpinEdit5: TSpinEdit;
          SpinEdit6: TSpinEdit;
          SpinEdit7: TSpinEdit;
          SpinEdit8: TSpinEdit;
        SG_VersionStringInfo: TStringGrid;
        Lbl_Translation: TLabel;
        CB_Translation: TComboBox;
        Btn_ImportVI: TButton;
        Btn_GenerateVI: TButton;
      Tab_Preview: TTabSheet;
        ScrollBox1: TScrollBox;
        Image1: TImage;
        Animate1: TAnimate;
        Button5: TButton;
        Memo1: TMemo;
        Panel1: TPanel;
          Btn_ReplaceVI: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Btn_Modify: TButton;
    Edit_Params: TEdit;
    procedure Btn_CreateClick(Sender: TObject);
    procedure Btn_AddClick(Sender: TObject);
    procedure Btn_LoadFileClick(Sender: TObject);
    procedure Btn_LoadRCClick(Sender: TObject);
    procedure Btn_GenerateVIClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Btn_ReplaceVIClick(Sender: TObject);
    procedure SpinEdit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SpinEdit1Enter(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Btn_ChooseCompilerClick(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Btn_DelClick(Sender: TObject);
    procedure ListBox1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure SB_UpdateClick(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure Button5Click(Sender: TObject);
    procedure CB_LanguageChange(Sender: TObject);
    procedure Btn_ImportVIClick(Sender: TObject);
    procedure Btn_ModifyClick(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure ImportVersionInfo;
    function GetEntryByName(name:string):TListItem;
    function AddEntry(typ,name,value:string):TListItem;
    procedure SetLanguage(value:string);
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  public
    { Public-Deklarationen }
    Procedure LoadRC(filename:String);
    procedure AddFile(filename:string);
    function preview(filename:string):boolean;
  end;

var
  Form_RFEMain: TForm_RFEMain;
  loading:Boolean;

implementation

{$R *.DFM}

uses RedirectConsole,getversioninfo,Version_u,Localize;

function ExtractBaseName(Filename:String):String;
var i:integer;
begin
  i:=length(Filename);
  while (i>0) and (Filename[i]<>'.') do dec(i);
  if i>0 then
    result:=copy(filename,1,i-1)
  else
    result:=Filename;
end;

function StripQuotes(s:String):String;
begin
  result:=s;
  if copy(result,1,1)='"' then delete(result,1,1);
  if copy(result,length(result),1)='"' then delete(result,length(result),1);
end;

function TForm_RFEMain.GetEntryByName(name:string):TListItem;
var i:integer;
begin
  result:=nil;
  for i:=0 to listview1.Items.Count-1 do
    if lowercase(Listview1.Items[i].subitems[0])=lowercase(name) then result:=Listview1.Items[i];
end;

function TForm_RFEMain.AddEntry(typ,name,value:string):TListItem;
var li:TListitem;
begin
  result:=nil;
  li:=GetEntryByName(name);
  if not assigned(li) then
  begin
    li:=Listview1.Items.Add;
    li.Caption:=uppercase(typ);
    li.SubItems.Add(uppercase(name));
    li.SubItems.Add(value);
    result:=li;
  end;
end;

Procedure TForm_RFEMain.LoadRC(filename:String);
var sl: TStringlist;
    i,p,blockstart,blockend: integer;
    s1,s2,s3: String;
begin
  sl:=TStringlist.create;
  sl.LoadFromFile(filename);
  i:=0;
  while i<sl.count do
  begin
    s3:=trim(sl.strings[i]);
    p:=pos(' ',s3);
    s1:=trim(copy(s3,1,p-1));
    delete(s3,1,p);
    p:=pos(' ',s3);
    s2:=trim(copy(s3,1,p-1));
    delete(s3,1,p);
    s3:=trim(s3);
    if s3<>'' then
    begin
      if lowercase(s3)='versioninfo' then
      begin
        blockstart:=0;
        blockend:=0;
        inc(i);
        while (blockstart=0) or (blockstart<>blockend) do
        begin
          memo1.lines.add(sl.strings[i]);
          s3:=lowercase(trim(sl.strings[i]));
          if (s3='begin') or (s3='{') then inc(blockstart);
          if (s3='end') or (s3='}') then inc(blockend);
          inc(i);
        end;
        ImportVersionInfo;
        if not assigned(AddEntry('VERSIONINFO',s1,Memo1.lines.text)) then
          showmessage(format(LocalizeString('Msg_IDExists'),[s1]));
      end else if lowercase(s3)='stringtable' then
      begin
        blockstart:=0;
        blockend:=0;
        inc(i);
        while (blockstart=0) or (blockstart<>blockend) do
        begin
          s3:=lowercase(trim(sl.strings[i]));
          if (s3='begin') or (s3='{') then inc(blockstart) else
          if (s3='end') or (s3='}') then inc(blockend) else
          begin
            p:=pos(' ',s3);
            s1:=trim(copy(s3,1,p-1));
            delete(s3,1,p);
            s3:=trim(s3);
            addEntry('STRINGTABLE',s1,StripQuotes(S3));
          end;
          inc(i);
        end;
      end else
      begin
        addEntry(s2,s1,StripQuotes(S3));
      end;
    end;
    inc(i);
  end;
  sl.free;
end;

procedure TForm_RFEMain.Btn_CreateClick(Sender: TObject);
var sl: TStringlist;
    i : integer;
begin
if fileExists(Edit_Compiler.text) then
begin
  if Listview1.items.count>0 then
  begin
    sl:=TStringlist.Create;
    i:=0;
    while i<listview1.Items.Count do
    begin
      if listview1.items[i].caption='VERSIONINFO' then
      begin
        sl.add(listview1.items[i].subitems[0]+' '+listview1.items[i].caption);
        sl.add(Listview1.items[i].subitems[1]);
      end else if listview1.items[i].caption='STRINGTABLE' then
      begin
        sl.add('STRINGTABLE');
        sl.add('BEGIN');
        while (i<listview1.items.count) and (listview1.items[i].caption='STRINGTABLE') do
        begin
          sl.add('  '+listview1.items[i].subitems[0]+' '+' "'+Listview1.items[i].subitems[1]+'"');
          inc(i);
        end;
        sl.add('END');
        dec(i);
      end else
        sl.add(listview1.items[i].subitems[0]+' '+listview1.items[i].caption+' "'+Listview1.items[i].subitems[1]+'"');
      inc(i);
      sl.add('');
    end;
    if savedialog1.Execute then
    begin
      sl.SaveToFile(savedialog1.filename);
      //shellexecute(0,'open',PCHAR(Edit_Compiler.Text),PCHAR('"'+savedialog1.filename+'"'),PCHAR(extractfilepath(savedialog1.filename)),sw_show);
      RC_Run(Edit_Compiler.Text+' '+Edit_Params.Text+' "'+savedialog1.filename+'"');
    end;
    sl.free;
  end else showmessage(LocalizeString('Msg_NothingToCompile'));
end else Showmessage(LocalizeString('Msg_CompilerNotFound'));
end;

procedure TForm_RFEMain.Btn_AddClick(Sender: TObject);
var LI:TListItem;
begin
  if (CB_Type.ItemIndex>-1) and (Edit_Name.Text<>'') and (Edit_Value.Text<>'') then
  begin
    li:=addEntry(CB_Type.Text,Edit_Name.Text,Edit_Value.Text);
    if assigned(li) then
      LI.Selected:=True
    else
      showmessage(format(LocalizeString('Msg_IDExists'),[Edit_Name.Text]));
    CB_Type.ItemIndex:=-1;
    Edit_Name.Text:='';
    Edit_Value.Text:='';
  end else showmessage(LocalizeString('Msg_MissingInput'));
end;

procedure TForm_RFEMain.AddFile(filename:string);
var ext,n:string;
    i:integer;
begin
  Edit_Value.Text:=FileName;
  ext:=UpperCase(ExtractFileExt(FileName));
  if ext='.BMP' then CB_Type.ItemIndex:=0
  else if ext='.ICO' then CB_Type.ItemIndex:=1
  else if (ext='.CUR') then CB_Type.ItemIndex:=2
  else if (ext='.ANI') then CB_Type.ItemIndex:=3
  else if ext='.WAV' then CB_Type.ItemIndex:=4
  else if ext='.AVI' then CB_Type.ItemIndex:=5
  else CB_Type.ItemIndex:=6;
  i:=1;
  n:=copy(cb_Type.Text,1,3);
  while getentrybyName(n+inttostr(i))<>nil do inc(i);
  edit_Name.Text:=n+inttostr(i);
end;

procedure TForm_RFEMain.Btn_LoadFileClick(Sender: TObject);
begin
  opendialog1.Filter:='Alle Dateien (*.*)|*.*|Bitmaps (*.bmp)|*.bmp|Icons (*.ico)|*.ico|Cursor (*.cur;*.ani)|*.cur;*.ani|JPEG (*.jpg;*.jpeg)|*.jpg;*.jpeg|AVI (*.avi)|*.avi|Wave (*.wav)|*.wav';
  if opendialog1.Execute then
  begin
    AddFile(opendialog1.filename);
    preview(opendialog1.filename);
  end;
end;

procedure TForm_RFEMain.Btn_LoadRCClick(Sender: TObject);
begin
  opendialog1.Filter:='RC-Dateien|*.rc';
  if opendialog1.execute then
  begin
    listview1.items.clear;
    loadrc(opendialog1.filename);
  end;
end;

procedure TForm_RFEMain.Btn_GenerateVIClick(Sender: TObject);
var p:integer;
begin
p:=pos(':',CB_Translation.text);
memo1.text:=
  'FILEVERSION '+inttostr(Spinedit1.value)+','+inttostr(Spinedit2.value)+','+inttostr(Spinedit3.value)+','+inttostr(Spinedit4.value)+#13#10+
  'PRODUCTVERSION '+inttostr(Spinedit5.value)+','+inttostr(Spinedit6.value)+','+inttostr(Spinedit7.value)+','+inttostr(Spinedit8.value)+#13#10+
  'BEGIN'+#13#10+
  '  BLOCK "StringFileInfo"'+#13#10+
  '  BEGIN'+#13#10+
  '    BLOCK "040704b0"'+#13#10+
  '    BEGIN'+#13#10+
  '      VALUE "FileVersion", "'+inttostr(Spinedit1.value)+'.'+inttostr(Spinedit2.value)+'.'+inttostr(Spinedit3.value)+'.'+inttostr(Spinedit4.value)+'\0"'+#13#10+
  '      VALUE "ProductVersion", "'+inttostr(Spinedit5.value)+'.'+inttostr(Spinedit6.value)+'.'+inttostr(Spinedit7.value)+'.'+inttostr(Spinedit8.value)+'\0"'+#13#10+
  '      VALUE "ProductName", "'+SG_VersionStringInfo.Cells[1,0]+'\0"'+#13#10+
  '      VALUE "CompanyName", "'+SG_VersionStringInfo.Cells[1,1]+'\0"'+#13#10+
  '      VALUE "FileDescription", "'+SG_VersionStringInfo.Cells[1,2]+'\0"'+#13#10+
  '      VALUE "InternalName", "'+SG_VersionStringInfo.Cells[1,3]+'\0"'+#13#10+
  '      VALUE "LegalCopyright", "'+SG_VersionStringInfo.Cells[1,4]+'\0"'+#13#10+
  '      VALUE "OriginalFilename", "'+SG_VersionStringInfo.Cells[1,5]+'\0"'+#13#10+
  '    END'+#13#10+
  '  END'+#13#10+
  '  BLOCK "VarFileInfo"'+#13#10+
  '  BEGIN'+#13#10+
  '    VALUE "Translation", '+copy(CB_Translation.text,p+1,length(CB_Translation.text)-p)+', 1200'+#13#10+
  '  END'+#13#10+
  'END';
  PageControl1.ActivePage:=Tab_Preview;
  memo1.visible:=true;
  panel1.Visible:=true;
end;

procedure MyLineOut(s: string); // Output procedure
begin
  form_RFEMain.listbox1.items.add(s);
end;

procedure TForm_RFEMain.FormCreate(Sender: TObject);
var ini:TIniFile;
    vi:TVersionInfo;
    sr:TSearchRec;
    lang:string;
begin
  loading:=true;
  SG_VersionStringInfo.Cells[0,0]:='Produkt-Name';
  SG_VersionStringInfo.Cells[0,1]:='Firmen-Name';
  SG_VersionStringInfo.Cells[0,2]:='Datei-Beschreibung';
  SG_VersionStringInfo.Cells[0,3]:='interner Name';
  SG_VersionStringInfo.Cells[0,4]:='Copyright';