xpmain.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:4k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit xpmain;
  2. (*
  3.  * The contents of this file are subject to the Mozilla Public
  4.  * License Version 1.1 (the "License"); you may not use this file
  5.  * except in compliance with the License. You may obtain a copy of
  6.  * the License at http://www.mozilla.org/MPL/
  7.  *
  8.  * Software distributed under the License is distributed on an "AS
  9.  * IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  10.  * implied. See the License for the specific language governing
  11.  * rights and limitations under the License.
  12.  *
  13.  * This code was inspired to expidite the creation of unit tests 
  14.  * for use the Dunit test frame work.
  15.  * 
  16.  * The Initial Developer of XPGen is Michael A. Johnson.
  17.  * Portions created The Initial Developer is Copyright (C) 2000.
  18.  * Portions created by The DUnit Group are Copyright (C) 2000.
  19.  * All rights reserved.
  20.  *
  21.  * Contributor(s):
  22.  * Michael A. Johnson <majohnson@golden.net>
  23.  * Juanco A馿z <juanco@users.sourceforge.net>
  24.  * Chris Morris <chrismo@users.sourceforge.net>
  25.  * Jeff Moore <JeffMoore@users.sourceforge.net>
  26.  * The DUnit group at SourceForge <http://dunit.sourceforge.net>
  27.  *
  28.  *)
  29. interface
  30. uses
  31.   Windows,
  32.   Messages,
  33.   SysUtils,
  34.   Classes,
  35.   Graphics,
  36.   Controls,
  37.   Forms,
  38.   xpParse,
  39.   xpCodeGen,
  40.   Dialogs,
  41.   StdCtrls,
  42.   parsedef, Menus;
  43. type
  44.   
  45.   TfrmxpgenMain = class(TForm)
  46.     memoSrcOutput: TMemo;
  47.     MainMenu1: TMainMenu;
  48.     File1: TMenuItem;
  49.     mnuOpen: TMenuItem;
  50.     N1: TMenuItem;
  51.     eXit1: TMenuItem;
  52.     odOpen: TOpenDialog;
  53.     edit1: TMenuItem;
  54.     Copy1: TMenuItem;
  55.     procedure mnuOpenClick(Sender: TObject);
  56.     procedure eXit1Click(Sender: TObject);
  57.     procedure FormShow(Sender: TObject);
  58.     procedure Copy1Click(Sender: TObject);
  59.     procedure FormCreate(Sender: TObject);
  60.   private
  61.   public
  62.     { Public declarations }
  63.     fnameOfstring : string;
  64.     procedure ProcessSrcFile(srcFilename : TFilename);
  65.   published
  66.     procedure X; virtual;
  67.     procedure Y; virtual; 
  68.     property NameOfString : string read fnameOfString;
  69.   end;
  70. var
  71.   frmxpgenMain: TfrmxpgenMain;
  72. implementation
  73. {$R *.DFM}
  74. uses 
  75.   clipbrd,
  76.   typinfo, 
  77.   test_xpParse;
  78. const
  79.   appName = 'XPGen';
  80.   
  81. procedure TfrmxpgenMain.X;
  82. begin
  83. end;
  84. procedure TfrmxpgenMain.Y;
  85. begin
  86. end;
  87. procedure TfrmxpgenMain.mnuOpenClick(Sender: TObject);
  88. begin
  89.   if odOpen.Execute then
  90.     begin
  91.       ProcessSrcFile(odOpen.FileName);
  92.     end;
  93. end;
  94. procedure TfrmxpgenMain.eXit1Click(Sender: TObject);
  95. begin
  96.   close;
  97. end;
  98. procedure TfrmxpgenMain.ProcessSrcFile(srcFilename: TFilename);
  99. var
  100.   inputFile: TFileStream;
  101.   XPParser : TXPStubParser;
  102.   SrcGen : SrcGenExternalTest;
  103. begin
  104.   caption := format('%s - [%s]',[appName,srcFilename]);
  105.   memoSrcOutput.lines.clear;
  106.   inputFile := nil;
  107.   try
  108.     InputFile := TFileStream.Create(srcFilename, fmOpenRead);
  109.     XPParser := nil;
  110.     try
  111.       XPParser := TXPStubParser.Create;    
  112.       XPParser.SrcStream := inputFile;
  113.       XPParser.Parse;
  114.       SrcGen := SrcGenExternalTest.Create(XPParser.unitName,DriverSrcOutputTstrings.Create(memoSrcOutput.lines));
  115.       SrcGen.GenerateCode(XPParser.ParseNodeList);
  116.       SrcGen.Free;
  117.     finally
  118.       XPParser.Free;
  119.     end;
  120.   finally
  121.     InputFile.free;
  122.   end;
  123. end;
  124. procedure TfrmxpgenMain.FormShow(Sender: TObject);
  125. begin
  126.   memoSrcOutput.lines.clear;
  127. end;
  128. procedure TfrmxpgenMain.Copy1Click(Sender: TObject);
  129. var
  130.   bufToClipboard : Pchar;
  131. begin
  132.   if length(memoSrcOutput.text) > 0 then
  133.     begin
  134.       bufToClipboard := nil;
  135.       try
  136.        bufToClipboard := StrAlloc(length(memoSrcOutput.text)+1);
  137.        StrPCopy(bufToClipboard,memoSrcOutput.text);
  138.        try
  139.          ClipBoard.open;
  140.          Clipboard.SetTextBuf(bufToClipboard);
  141.        finally
  142.          ClipBoard.Close;
  143.        end;
  144.       finally
  145.         if bufToClipboard <> nil then
  146.           StrDispose(bufToClipboard);
  147.       end;
  148.     end;
  149. end;
  150. procedure TfrmxpgenMain.FormCreate(Sender: TObject);
  151. begin
  152.   caption := appName;
  153. end;
  154. end.
  155.