main.pas

服务器源代码生成器 source 源代码(delphi 6编译通过) bin 可执行程序、配置文件和资源文件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MyConst, Buttons, FileCtrl, IniFiles;

type
  TForm1 = class(TForm)
    Edt_PrjName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edt_SvrClassName: TEdit;
    Label3: TLabel;
    Edt_SvrDisplayName: TEdit;
    Label4: TLabel;
    Edt_SvrManagerClassName: TEdit;
    Label5: TLabel;
    Edt_WorkPath: TEdit;
    Btn_Do: TButton;
    Label6: TLabel;
    Edt_ServerUnit: TEdit;
    Label7: TLabel;
    Edt_SvrObjectName: TEdit;
    Memo1: TMemo;
    Label8: TLabel;
    Edt_SvrManagerUnit: TEdit;
    SpeedButton1: TSpeedButton;
    procedure Btn_DoClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1             : TForm1;

implementation

{$R *.dfm}

function AddDirSuffix(Dir: string): string;
 //目录尾加'\'修正
begin
  Result := Trim(Dir);
  if Result = '' then Exit;
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

function CreateDirEx(Dir: string): Boolean;
begin
  Result := True;

  if Length(Dir) = 0 then
  begin
    Result := False;
    Exit;
  end;
  Dir := ExcludeTrailingBackslash(Dir);
  if (Length(Dir) < 3) or DirectoryExists(Dir)
    or (ExtractFilePath(Dir) = Dir) then
    Exit;                               // avoid 'xyz:\' problem.
  Result := CreateDirEx(ExtractFilePath(Dir)) and CreateDir(Dir);
end;

procedure TForm1.FormShow(Sender: TObject);
var
  MyIniFile         : TIniFile;
begin
  MyIniFile := TIniFile.Create(ExtractFilePath(application.ExeName) +
    'setup.ini');
  try
    Edt_WorkPath.Text := MyIniFile.ReadString('COMMON', 'WorkPath', '');
    Edt_PrjName.Text := MyIniFile.ReadString('COMMON', 'PrjName',
      'ServerDemoPrj');
    Edt_ServerUnit.Text := MyIniFile.ReadString('COMMON', 'ServerUnit',
      'ServerDemoUnit');
    Edt_SvrClassName.Text := MyIniFile.ReadString('COMMON', 'SvrClassName',
      'TServerDemo');
    Edt_SvrObjectName.Text := MyIniFile.ReadString('COMMON', 'SvrObjectName',
      'ServerDemo');
    Edt_SvrDisPlayName.Text := MyIniFile.ReadString('COMMON', 'SvrDisPlayName',
      'A Demo Server');
    Edt_SvrManagerClassName.Text := MyIniFile.ReadString('COMMON',
      'SvrManagerClassName', 'TSvrManager');
    Edt_SvrManagerUnit.Text := MyIniFile.ReadString('COMMON', 'SvrManagerUnit',
      'SvrManager');
  finally
    MyIniFile.Free;
  end;
end;

procedure TForm1.Btn_DoClick(Sender: TObject);
var
  PrjFile           : string;
  SvrUnitFile       : string;
  SvrFormFile       : string;
  SvrManagerUnitFile: string;
  FormTestPrjFile   : string;
  FormTestUnit      : string;
  FileText          : TStringList;
  path              : string;
  MyIniFile         : TIniFile;
begin
  Edt_WorkPath.Text := Trim(Edt_WorkPath.Text);
  Edt_PrjName.Text := Trim(Edt_PrjName.Text);
  Edt_ServerUnit.Text := Trim(Edt_ServerUnit.Text);
  Edt_SvrClassName.Text := Trim(Edt_SvrClassName.Text);
  Edt_SvrObjectName.Text := Trim(Edt_SvrObjectName.Text);
  Edt_SvrDisplayName.Text := Trim(Edt_SvrDisplayName.Text);
  Edt_SvrManagerClassName.Text := Trim(Edt_SvrManagerClassName.Text);
  Edt_SvrManagerUnit.Text := Trim(Edt_SvrManagerUnit.Text);


  if Edt_ServerUnit.Text = Edt_PrjName.Text then
  begin
    ShowMessage('服务单元文件名不能与项目文件名相同');
    Exit;
  end;

  if Edt_SvrClassName.Text = Edt_PrjName.Text then
  begin
    ShowMessage('服务类名不能与项目文件名相同');
    Exit;
  end;

  if Edt_SvrClassName.Text = Edt_ServerUnit.Text then
  begin
    ShowMessage('服务类名不能与服务单元文件名相同');
    Exit;
  end;

  if Edt_SvrObjectName.Text = Edt_PrjName.Text then
  begin
    ShowMessage('服务实例名不能与项目文件名相同');
    Exit;
  end;

  if Edt_SvrObjectName.Text = Edt_ServerUnit.Text then
  begin
    ShowMessage('服务实例名不能与服务单元文件名相同');
    Exit;
  end;

  if Edt_SvrObjectName.Text = Edt_SvrClassName.Text then
  begin
    ShowMessage('服务实例名不能与服务类名相同');
    Exit;
  end;

  if Edt_SvrManagerClassName.Text = Edt_PrjName.Text then
  begin
    ShowMessage('服务主控单元类名不能与项目文件名相同');
    Exit;
  end;

  if Edt_SvrManagerClassName.Text = Edt_ServerUnit.Text then
  begin
    ShowMessage('服务主控单元类名不能与服务单元名相同');
    Exit;
  end;

  if Edt_SvrManagerClassName.Text = Edt_SvrClassName.Text then
  begin
    ShowMessage('服务主控单元类名不能与服务类名相同');
    Exit;
  end;

  if Edt_SvrManagerClassName.Text = Edt_SvrObjectName.Text then
  begin
    ShowMessage('服务主控单元类名不能与服务实例名相同');
    Exit;
  end;

  if Edt_SvrManagerUnit.Text = Edt_PrjName.Text then
  begin
    ShowMessage('服务主控线程单元名不能与项目文件名相同');
    Exit;
  end;

  if Edt_SvrManagerUnit.Text = Edt_ServerUnit.Text then
  begin
    ShowMessage('服务主控线程单元名不能与服务单元名相同');
    Exit;
  end;

  if Edt_SvrManagerUnit.Text = Edt_SvrClassName.Text then
  begin
    ShowMessage('服务主控线程单元名不能与服务类名相同');
    Exit;
  end;

  if Edt_SvrManagerUnit.Text = Edt_SvrObjectName.Text then
  begin
    ShowMessage('服务主控线程单元名不能与服务实例名相同');
    Exit;
  end;

  if Edt_SvrManagerUnit.Text = Edt_SvrManagerClassName.Text then
  begin
    ShowMessage('服务主控线程单元名不能与服务主控单元类名相同');
    Exit;
  end;

  path := Trim(Edt_WorkPath.Text);
  if path = '' then
  begin
    ShowMessage('请输入源程序存放路径!');
    Exit;
  end;
  path := AddDirSuffix(path);
  if not Directoryexists(path) then
  begin
    if not CreateDirEx(path) then
    begin
      ShowMessage('源程序文件夹创建失败');
      Exit;
    end;
  end;

  MyIniFile := TIniFile.Create(ExtractFilePath(application.ExeName) +
    'setup.ini');
  try
    MyIniFile.WriteString('COMMON', 'WorkPath', Edt_WorkPath.Text);
    MyIniFile.WriteString('COMMON', 'PrjName', Edt_PrjName.Text);
    MyIniFile.WriteString('COMMON', 'ServerUnit', Edt_ServerUnit.Text);
    MyIniFile.WriteString('COMMON', 'SvrClassName', Edt_SvrClassName.Text);
    MyIniFile.WriteString('COMMON', 'SvrObjectName', Edt_SvrObjectName.Text);
    MyIniFile.WriteString('COMMON', 'SvrDisPlayName', Edt_SvrDisPlayName.Text);
    MyIniFile.WriteString('COMMON', 'SvrManagerClassName',
      Edt_SvrManagerClassName.Text);
    MyIniFile.WriteString('COMMON', 'SvrManagerUnit', Edt_SvrManagerUnit.Text);
  finally
    MyIniFile.Free;
  end;

  CopyFile(PChar(ExtractFilePath(application.ExeName) + 'svr.res'), PChar(path +
    Edt_PrjName.Text + '.res'), False);

  FileText := TStringList.Create;
  PrjFile := ProjectFile;
  PrjFile := StringReplace(PrjFile, '%PrjName', Edt_PrjName.Text, [rfReplaceAll,
    rfIgnoreCase]);
  PrjFile := StringReplace(PrjFile, '%ServerUnit', Edt_ServerUnit.Text,
    [rfReplaceAll, rfIgnoreCase]);
  PrjFile := StringReplace(PrjFile, '%SvrManagerUnit', Edt_SvrManagerUnit.Text,
    [rfReplaceAll, rfIgnoreCase]);
  PrjFile := StringReplace(PrjFile, '%SvrClassName', Edt_SvrClassName.Text,
    [rfReplaceAll, rfIgnoreCase]);
  PrjFile := StringReplace(PrjFile, '%SvrObjectName', Edt_SvrObjectName.Text,
    [rfReplaceAll, rfIgnoreCase]);
  Memo1.Lines.Append('******************项目文件*******************');
  Memo1.Lines.Append(PrjFile);
  Memo1.Lines.Append('');
  FileText.Text := PrjFile;
  FileText.SaveToFile(path + Edt_PrjName.Text + '.dpr');

  SvrUnitFile := ServerUnitFile;
  SvrUnitFile := StringReplace(SvrUnitFile, '%ServerUnit', Edt_ServerUnit.Text,
    [rfReplaceAll, rfIgnoreCase]);
  SvrUnitFile := StringReplace(SvrUnitFile, '%SvrManagerUnit',
    Edt_SvrManagerUnit.Text, [rfReplaceAll, rfIgnoreCase]);
  SvrUnitFile := StringReplace(SvrUnitFile, '%SvrClassName',
    Edt_SvrClassName.Text, [rfReplaceAll, rfIgnoreCase]);
  SvrUnitFile := StringReplace(SvrUnitFile, '%SvrManagerClassName',
    Edt_SvrManagerClassName.Text, [rfReplaceAll, rfIgnoreCase]);
  SvrUnitFile := StringReplace(SvrUnitFile, '%SvrObjectName',
    Edt_SvrObjectName.Text, [rfReplaceAll, rfIgnoreCase]);
  Memo1.Lines.Append('******************服务主单元文件*******************');
  Memo1.Lines.Append(SvrUnitFile);
  Memo1.Lines.Append('');
  FileText.Text := SvrUnitFile;
  FileText.SaveToFile(path + Edt_ServerUnit.Text + '.pas');

  SvrFormFile := ServerFormFile;
  SvrFormFile := StringReplace(SvrFormFile, '%SvrClassName',
    Edt_SvrClassName.Text, [rfReplaceAll, rfIgnoreCase]);
  SvrFormFile := StringReplace(SvrFormFile, '%SvrObjectName',
    Edt_SvrObjectName.Text, [rfReplaceAll, rfIgnoreCase]);
  SvrFormFile := StringReplace(SvrFormFile, '%SvrDisplayName',
    Edt_SvrDisplayName.Text, [rfReplaceAll, rfIgnoreCase]);
  Memo1.Lines.Append('******************服务主单元窗口文件*******************');
  Memo1.Lines.Append(SvrFormFile);
  Memo1.Lines.Append('');
  FileText.Text := SvrFormFile;
  FileText.SaveToFile(path + Edt_ServerUnit.Text + '.dfm');

  SvrManagerUnitFile := ServerManagerUnitFile;
  SvrManagerUnitFile := StringReplace(SvrManagerUnitFile, '%SvrManagerUnit',
    Edt_SvrManagerUnit.Text, [rfReplaceAll, rfIgnoreCase]);
  SvrManagerUnitFile := StringReplace(SvrManagerUnitFile,
    '%SvrManagerClassName', Edt_SvrManagerClassName.Text, [rfReplaceAll,
    rfIgnoreCase]);
  Memo1.Lines.Append('******************服务主控单元文件*******************');
  Memo1.Lines.Append(SvrManagerUnitFile);
  Memo1.Lines.Append('');
  FileText.Text := SvrManagerUnitFile;
  FileText.SaveToFile(path + Edt_SvrManagerUnit.Text + '.pas');

  path := path + 'formtest\';
  CopyFile(PChar(ExtractFilePath(application.ExeName) + 'formtest.res'), PChar(
    path + Edt_PrjName.Text + '_Test.res'), False);

  if not Directoryexists(path) then
  begin
    if not CreateDirEx(path) then
    begin
      ShowMessage('窗口测试程序源程序文件夹创建失败：' + path);
      Exit;
    end;
  end;

  FormTestPrjFile := FormTestProjectFile;
  FormTestPrjFile := StringReplace(FormTestPrjFile, '%FormTestPrjName',
    Edt_PrjName.Text + '_Test', [rfReplaceAll, rfIgnoreCase]);
  FormTestPrjFile := StringReplace(FormTestPrjFile, '%SvrManagerUnit',
    Edt_SvrManagerUnit.Text, [rfReplaceAll, rfIgnoreCase]);
  Memo1.Lines.Append('******************服务窗口测试程序项目文件*******************');
  Memo1.Lines.Append(FormTestPrjFile);
  Memo1.Lines.Append('');
  FileText.Text := FormTestPrjFile;
  FileText.SaveToFile(path + Edt_PrjName.Text + '_Test.dpr');

  FormTestUnit := FormTestUnitFile;
  FormTestUnit := StringReplace(FormTestUnit, '%SvrManagerUnit',
    Edt_SvrManagerUnit.Text, [rfReplaceAll, rfIgnoreCase]);
  FormTestUnit := StringReplace(FormTestUnit, '%SvrManagerClassName',
    Edt_SvrManagerClassName.Text, [rfReplaceAll, rfIgnoreCase]);
  Memo1.Lines.Append('******************服务窗口测试程序主单元文件*******************');
  Memo1.Lines.Append(FormTestUnit);
  Memo1.Lines.Append('');
  FileText.Text := FormTestUnit;
  FileText.SaveToFile(path + 'main.pas');

  Memo1.Lines.Append('******************服务窗口测试程序主窗口文件*******************');
  Memo1.Lines.Append(FormTestUnit);
  Memo1.Lines.Append('');
  FileText.Text := FormTestFormFile;
  FileText.SaveToFile(path + 'main.dfm');

  FileText.Free;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
  Dir               : string;
begin
  Dir := '';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 1000) then
    Edt_WorkPath.Text := Dir;
end;




end.