ucopy.pas

来自「说明: 需要安装ddk2k ddkxp才可以编译运行. 虚拟打印机驱动程序」· PAS 代码 · 共 62 行

unit ucopy;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Gauges { , threadcopy} ;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Gauge: TGauge;
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    nThreadsRunning : Integer;  // not used
    nFileCounter : Integer;     // index for filename
    StringList : TStrings;
    strTempDir : string;        // the <temp> / source directory
//    procedure ThreadDone(Sender : TObject);  // not used
    procedure ReadBinaryDataFile(strFilename : string);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

const
  EMFSTRING1 = #1#0#0#0#124#0#0#0;  // possible emf file types in
  EMFSTRING2 = #1#0#0#0#88#0#0#0;   // NT .spl files

implementation

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);
var
  SearchRes : TSearchRec;// search structure
  nGaugeCounter,         // makes nice gauge
  nFound, i : Integer;   // # of files found (when searching)
  strTemp : string[8];   // filename: <number>.emf
  strCnt : string;       // <full path> + <emf-file>
  strOSVer : string;     // OS version (Win95 / NT)
  lpszOSVer : PChar;
  strSpoolDir : string;  // spool-directory (NT only)
  strOldFile, strNewFile : string;
  lpszTempDir : PChar;   // %TEMP% dir (w95 & nt)
  lpszSpoolDir : PChar;  // spool dir (nt only)
begin
  // inits and allocs
  nGaugeCounter := 0;
  nThreadsRunning := 0;
  GetMem(lpszTempDir, 255);
  GetMem(lpszOSVer, 15);
  GetMem(lpszSpoolDir, 255);

  // %temp%-var set?
  if (GetEnvironmentVariable('temp', lpszTempDir, 255) = 0) then begin
    MessageDlg('Environment-Variable %temp% mu