apfaxcnv.dpr

此源码是用delphi封装的Socket邮件控件

{*********************************************************}
{*                 APFAXCNV.PAS 4.06                     *}
{*      Copyright (c) TurboPower Software 1997-2002      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$I AwDefine.inc}                                                        {!!.06}

{ 4.06 additions:
  removed unneeded $IFDEFs
  The fax printer driver supports several registry entries to control the
  print jobs. Absence of these values will cause default behavior.
  HKEY_LOCAL_MACHINE
    ApdRegKey - defined in OOMisc.pas as '\SOFTWARE\TurboPower\ApFaxCnv\Settings'
      // idShell conversions
      ShellHandle : Integer, determines whether we are in an idShell conversion
                    this is the window handle that will receive our messages
      ShellName   : string, the name of the resulting APF for an idShell conversion

      // spawning app when print job starts
      AutoExec    : string, the name of an app to spawn if a TApdFaxDriverInterface isn't found
      Timeout     : Integer, the time we'll wait for the app to spawn

      // debug logging
      EventLogging: Boolean, whether we log the codes/subcodes
      DumpLogging : Boolean, whether we record the raw printer data
      EventLog    : string, the path\name of the event log
      DumpLog     : string, the path\name of the dump log

      // general
      DefFileName : string, the default name of the resulting APF
      SuppressAV  : Boolean, true to suppress any APRO-raised AVs

      // Post-print job APF modifications
      HeadFiller  : Integer, a 1-byte value to be written to the APF's file header
                    in the Filler field, can be used to identify the machine, job, etc
      HeadPadding : string, a 26-char value to be written to the APF's file header
                    in the Padding field, can be used for phone number, ID, etc
      *remember, the Boolean is added manually in RegEdit via a DWORD value,
                 0 = false, 1 = true
}

library ApFaxCnv;

{$IFNDEF PRNDRV}
  !! Define PRNDRV in  Project | Options | Directories/Conditionals
  !! this will reduce the size of the driver
{$ENDIF}

uses
  Windows,
  SysUtils,
  Registry,
  OOMisc,
  AwFaxCvt;

{$R *.RES}

const
  Version = '1';
  EventLog : string = 'C:\FAXCONV.LOG';                                  {!!.06}
  DumpLog  : PAnsiChar = 'C:\FAXCONV.DMP';                               {!!.06}

var
  T : Text;
  EventLogging : Boolean;                                                {!!.06}
  DumpLogging  : Boolean;                                                {!!.06}
  SuppressAV   : Boolean;                                                {!!.06}

procedure LogEvent(Msg : ShortString);
  {- Write line of trace info to the log file}
begin
  if EventLogging then begin                                             {!!.06}
    try
      AssignFile(T,EventLog);{'C:\FAXCONV.LOG');}                        {!!.06}
      try
        Append(T);
      except
        on E:EInOutError do
          if E.ErrorCode = 2 then
            Rewrite(T)
          else
            raise;
      end;
      Write(T,DateTimeToStr(Now),':');
      WriteLn(T,Msg);
      CloseFile(T);
    except
      ShowException(ExceptObject,ExceptAddr);
    end;
  end;                                                                   {!!.06}
end;

function ClientAppRunning : Boolean;
  {- Check whether the controlling app. has been started.}
var
  Semaphore : THandle;
begin
  Result := False;

  Semaphore := OpenSemaphore(SYNCHRONIZE, False, ApdSemaphoreName);
  if Semaphore <> 0 then
    begin
      CloseHandle(Semaphore);
      Result := True;
    end
  else
    begin
      LogEvent('OpenSemaphore failed.');
      LogEvent('Reason:'+IntToStr(GetLastError));
    end;

  LogEvent('ClientAppRunning?');
  if Result then
    LogEvent('Yes')
  else
    LogEvent('No');
end;

function GetClientAppPath : string;
  {- Read the client app path (if any) from the registry.}
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey,False);
    Result := Reg.ReadString('AutoExec');
    LogEvent('GetClientAppPath:'+Result);
  finally
    Reg.Free;
  end;
end;

function GetTimeout : LongInt;
  {- Read the timeout value for waiting for the client from the registry.}
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey,False);
    try
      Result := Reg.ReadInteger('Timeout');
    except
      Result := LongInt(INFINITE);
    end;
    LogEvent('Timeout:'+IntToStr(Result));
  finally
    Reg.Free;
  end;
end;

procedure GetDriverSettings;                                             {!!.06}
  {- See if we should be logging the major events and dumping the data  }
  {  called when the printer driver is loaded and when print jobs start }
var
  Reg : TRegistry;
  S : string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey, False);
    try
      EventLogging := Reg.ReadBool('EventLogging');
    except
      EventLogging := False;
    end;
    try
      EventLog := Reg.ReadString('EventLog');
    except
      EventLog := 'C:\FAXCONV.LOG';
    end;
    try
      DumpLogging := Reg.ReadBool('DumpLogging');
    except
      DumpLogging := False;
    end;
    try
      S := Reg.ReadString('DumpLog');
      StrPCopy(DumpLog, S);
    except
      DumpLog := 'C:\FAXCONV.DMP';
    end;
    try
      SuppressAV := Reg.ReadBool('SuppressAV');
    except
      SuppressAV := False;
    end;
  finally
    Reg.Free;
  end;
end;

function GetDefaultFileName : string;                                    {!!.06}
var
  Reg : TRegistry;
begin
  Result := ApdDefFileName;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey, False);
    Result := Reg.ReadString('DefFileName');
    if Result = '' then
      Result := ApdDefFileName;
  finally
    Reg.Free;
  end;
end;

procedure GetHeaderMods(var FaxHeader : TFaxHeaderRec);                  {!!.06}
var
  Reg : TRegistry;
  temp : string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey, False);
    Temp := Reg.ReadString('HeadFiller');
    if Length(Temp) > 0 then
      FaxHeader.Filler := Ord(Temp[1]);
    Temp := Reg.ReadString('HeadPadding');
    if Length(Temp) > 26 then
      Temp := Copy(Temp, 1, 26);
    Move(Temp[1], FaxHeader.Padding, Length(Temp));
  finally
    Reg.Free;
  end;
end;

function GetShellHandle : THandle;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey, False);
    try
      Result := Reg.ReadInteger('ShellHandle');
    except
      Result := INVALID_HANDLE_VALUE;
    end;
    LogEvent('ShellHandle:'+IntToStr(Result));
  finally
    Reg.Free;
  end;
end;

function GetShellName : string;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey, False);
    Result := Reg.ReadString('ShellName');
    if Result = '' then
      Result := GetDefaultFileName;{ApdDefFileName;}                     {!!.06}
    LogEvent('ShellName:'+Result);
  finally
    Reg.Free;
  end;
end;

procedure RemoveShellRegKeys;
var
  Reg : TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(ApdRegKey,False);
    Reg.DeleteValue('ShellName');
    Reg.DeleteValue('ShellHandle');
    LogEvent('Removed shell reg keys');
  finally
    Reg.Free;
  end;
end;

procedure HandleError(const ErrorText : string);                         {!!.06}
begin
  LogEvent('***' + ErrorText);
  if not SuppressAV then
    raise Exception.Create(ErrorText);
end;

function StartClientApp(AppPath : string) : Bool;
  {- Execute command line with default settings.}
var
  StartupInfo : TStartupInfo;
  ProcessInfo : TProcessInformation;
begin
  FillChar(StartupInfo,Sizeof(StartupInfo),0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_SHOWDEFAULT;
  LogEvent('StartClientApp:'+AppPath);
  Result :=
  CreateProcess(
    nil,                   {Application name (nil = take from next arg.)}
    pChar(AppPath),
    nil,                   {Process security attributes}
    nil,                   {Thread security attributes}
    false,                 {Inheritance flag}
    CREATE_NEW_CONSOLE or  {Creation flags}
    NORMAL_PRIORITY_CLASS,
    nil,                   {Environment block}
    nil,                   {Current directory name}
    StartupInfo,
    ProcessInfo);
  if not Result then
    LogEvent('CreateProcess failed. Reason:'+IntToStr(GetLastError));
end;

const
  BufferSize = 16384; // Could be anything > 560 (two landscape scan lines)
type
  pScanNode = ^tScanNode;
  tScanNode =
    record
      {used for landscape orientation only}
      ScanLines : array[1..8] of pointer;
      slIndex   : byte;
      NextNode  : pScanNode;
    end;
  TBuffer = array[0..pred(BufferSize)] of Byte;
  TFaxConvData = record
    FileHandle      : THandle;               {Raw dump file handle}
    apfConverter    : PAbsFaxCvt;            {Converter handle}
    cvtLastError    : Integer;               {Last error reported by converter}
    Buffer          : TBuffer;               {Local data buffer}
    ReadPtr         : 0..pred(BufferSize);   {Next byte to be processed}
    BytesInBuffer   : 0..BufferSize;         {Bytes in buffer}
    HaveData        : Bool;                  {Indicates whether data has been converted but not written}
    IsLandscape     : Bool;
    slDest          : PByteArray;            {Used during landscape rotation}
    slDataSize      : Integer;               {Used during landscape rotation}
    slBitWidth      : Integer;
    FirstScanNode   : pScanNode;
    CurrentScanNode : pScanNode;
  end;
  PFaxConvData = ^TFaxConvData;

procedure FaxConvInit; cdecl;
  {- Called by port driver during initialization.}
  {- Can be used for initialization.}
begin
  try
    GetDriverSettings;                                                   {!!.06}
    LogEvent('FaxConvInit');
    { make sure we don't have any residual registry keys... }
    RemoveShellRegKeys;
  except
    ShowException(ExceptObject,ExceptAddr);
  end;
end;

function FaxConvStartDoc(DocName : PWideChar) : THandle; cdecl;
  {- Called by port driver when a new document is about to print.}
  {- Create output file(s) and notify client (if any).}
var
  FaxConvData        : PFaxConvData {Our data structure for this job.}
    absolute Result;                {Note! Pointer treated as handle.}
  Res                : Bool;        {Pipe API result var.}
  BytesReadFromPipe  : DWord;
  Semaphore          : THandle;     {For waiting for client to start.}
  PipeReadBuffer,
  PipeWriteBuffer    : TPipeEvent;
  ClientAppName      : string;      {Path to auto-start client.}
  ShellHandle        : THandle;
begin
  // see if we should be logging this
  GetDriverSettings;                                                     {!!.06}
  LogEvent('FaxConvStartDoc'+WideCharToString(DocName));
  try
    Result := 0;
    { see if the TApdFaxConverter is doing a ShellExecute }
    ShellHandle := GetShellHandle;
    if ShellHandle = INVALID_HANDLE_VALUE then begin
      if not ClientAppRunning then begin
        ClientAppName := GetClientAppPath;
        if ClientAppName <> '' then begin
          Semaphore := CreateSemaphore(nil, 0, 1, ApdSemaphoreName);
          if Semaphore <> 0 then
            try
              if StartClientApp(ClientAppName) then
                begin
                  LogEvent('Client app. started');
                  if Semaphore <> 0 then begin
                    LogEvent('Waiting for client...');