sendfax0.pas

使用Modem发送传真

{**********************************************************}
{*                     SENDFAX0.PAS                       *}
{*   Copyright (c) TurboPower Software Company 1996-98    *}
{*                  All rights reserved                   *}
{**********************************************************}

unit Sendfax0;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, OoMisc, AdFax, AdFStat, AdPort, ExtCtrls,
  SendFax1, AdTapi, AdExcept, ComCtrls, Buttons,FileCtrl;
const
  Receive=0;
  Send=1;
type
  PAddEntry = ^TAddEntry;
  TAddEntry = record
    FaxName     : String;      //接收者姓名
    CoverName   : String;      //
    PhoneNumber : String;       //传真号码
    NextEntry   : PAddEntry;    //下个号码
  end;

  TsfMain = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label7: TLabel;
    SendFax: TButton;
    sfAdd: TButton;
    sfExit: TButton;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    sfFaxClass: TRadioGroup;
    sfModemInit: TEdit;
    sfHeader: TEdit;
    sfStationID: TEdit;
    sfDialPrefix: TEdit;
    sfDialAttempts: TEdit;
    sfRetryWait: TEdit;
    EnhText: TCheckBox;
    HdrFontBtn: TButton;
    CvrFontBtn: TButton;
    sfModify: TButton;
    sfDelete: TButton;
    sfFaxListBox: TListBox;
    sfSelectComPort: TButton;
    ApdComPort1: TApdComPort;
    ApdFaxStatus1: TApdFaxStatus;
    ApdSendFax1: TApdSendFax;
    ApdFaxLog1: TApdFaxLog;
    ApdTapiDevice1: TApdTapiDevice;
    FontDialog1: TFontDialog;
    Panel2: TPanel;
    Label8: TLabel;
    Label9: TLabel;
    rfFaxClass: TRadioGroup;
    rfNameStyle: TRadioGroup;
    rfDirectory: TEdit;
    rfModemInit: TEdit;
    Panel3: TPanel;
    Label10: TLabel;
    rfReceiveList: TListBox;
    rfReceiveFaxes: TButton;
    rfExit: TButton;
    rfSelectPort: TButton;
    ApdReceiveFax1: TApdReceiveFax;
    BitBtn1: TBitBtn;
    procedure SendFaxClick(Sender: TObject);
    procedure sfAppendAddList(FName, CName, PNumber : String);
    procedure sfGetAddListEntry(var FName, CName, PNumber : String);
    procedure sfAddPrim;
    procedure sfAddClick(Sender: TObject);
    procedure sfAddFromCmdLine;
    procedure ApdSendFax1FaxNext(CP: TObject; var ANumber, AFileName,
      ACoverName: TPassString);
    procedure ApdSendFax1FaxFinish(CP: TObject; ErrorCode: Integer);
    procedure sfExitClick(Sender: TObject);
    procedure sfModifyClick(Sender: TObject);
    procedure sfDeleteClick(Sender: TObject);
    procedure ApdSendFax1FaxLog(CP: TObject; LogCode: TFaxLogCode);
    procedure sfFaxClassClick(Sender: TObject);
    procedure sfDialAttemptsChange(Sender: TObject);
    procedure sfRetryWaitChange(Sender: TObject);
    procedure sfStationIDChange(Sender: TObject);
    procedure sfDialPrefixChange(Sender: TObject);
    procedure sfModemInitChange(Sender: TObject);
    procedure sfHeaderChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sfSelectComPortClick(Sender: TObject);
    procedure ApdTapiDevice1TapiPortOpen(Sender: TObject);
    procedure ApdTapiDevice1TapiPortClose(Sender: TObject);
    procedure HdrFontBtnClick(Sender: TObject);
    procedure CvrFontBtnClick(Sender: TObject);
    procedure rfSelectPortClick(Sender: TObject);
    procedure rfReceiveFaxesClick(Sender: TObject);
    procedure rfExitClick(Sender: TObject);
    procedure rfFaxClassClick(Sender: TObject);
    procedure rfDirectoryChange(Sender: TObject);
    procedure rfModemInitChange(Sender: TObject);
    procedure rfNameStyleClick(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure ApdReceiveFax1FaxError(CP: TObject; ErrorCode: Integer);
    procedure ApdReceiveFax1FaxFinish(CP: TObject; ErrorCode: Integer);
    procedure ApdReceiveFax1FaxLog(CP: TObject; LogCode: TFaxLogCode);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
    FaxList     : TStringList;
    FaxIndex    : Word;
    InProgress  : Boolean;
    Current:integer;
    AddsInProgress    : Boolean;
    AddsPending       : Word;
    AddList           : PAddEntry;
    ProcessedCmdLine  : Boolean;

  public
    { Public declarations }
    constructor Create(AComponent : TComponent); override;
    destructor Destroy; override;
    procedure sfAddFromPrinterDriver(var Message: TMessage);
      message APW_PRINTDRIVERJOBCREATED;
  end;

var
  sfMain: TsfMain;

implementation

{$R *.DFM}
function LimitS(const S : String; Len : Word) : String;
//减小显示的长度
begin
  if Length(S) > Len then
    Result := Copy(S, 1, Len) + '...'
  else
    Result := S;
end;

constructor TsfMain.Create(AComponent : TComponent);
  {-Create the form}
begin
  inherited Create(AComponent);
  FaxList     := TStringList.Create;
  InProgress  := False;
  AddList     := nil;
  AddsPending := 0;
  AddsInProgress := False;
  ProcessedCmdLine := False;
   rfDirectory.Text := ApdReceiveFax1.DestinationDir;
  rfModemInit.Text := ApdReceiveFax1.ModemInit;

end;

destructor TsfMain.Destroy;
begin
  FaxList.Free;
  inherited Destroy;
end;

procedure TsfMain.FormShow(Sender: TObject);
  {-Handle any command line arguments}
begin
  if not ProcessedCmdLine then begin
    sfAddFromCmdLine;
    ProcessedCmdLine := True;
    if sfHeader.Text = 'Fax sent by $I using APro    $D $T' then
      sfHeader.Text := 'Fax sent by $I using APro ' + ApdComPort1.Version + '   $D $T';
  end;
end;

procedure TsfMain.SendFaxClick(Sender: TObject);
//发送传真
begin
  if not InProgress then begin
    InProgress := True;
    //获得用户
    FaxIndex := 0;
    ApdSendFax1.FaxClass := TFaxClass(sfFaxClass.ItemIndex+1);
    try
      //尝试次数
      ApdSendFax1.DialAttempts := StrToInt(sfDialAttempts.Text);
      //等待时间
      ApdSendFax1.DialRetryWait := StrToInt(sfRetryWait.Text);
    except
    end;
    ApdSendFax1.EnhTextEnabled := EnhText.Checked;
    ApdSendFax1.StationID := sfStationID.Text;
    ApdSendFax1.DialPrefix := sfDialPrefix.Text;
    ApdSendFax1.ModemInit := sfModemInit.Text;    //初始化Modem
    ApdSendFax1.HeaderLine := sfHeader.Text;     //传真头

    if (ApdComPort1.TapiMode = tmOn) or
       ((ApdComPort1.TapiMode = tmAuto) and
        (ApdTapiDevice1.SelectedDevice <> '')) then begin
        //Tapi设置，打开端口
      ApdTapiDevice1.ConfigAndOpen;
    end else begin
      //打开端口开始发送
      try
        ApdComPort1.Open := True;
      except
        InProgress := False;
        raise;
      end;
      ApdSendFax1.StartTransmit;
    end;
  end else
    MessageBeep(0);
end;

procedure TsfMain.sfAppendAddList(FName, CName, PNumber : String);
//新添一个到发送列表中
var
  NewEntry : PAddEntry;
begin
  if AddList = nil then begin
    //清空记录
    GetMem(AddList, sizeof(TAddEntry));
    NewEntry := AddList;
  end else begin
    //末尾指针
    NewEntry := AddList;
    while NewEntry^.NextEntry <> nil do
      NewEntry := NewEntry^.NextEntry;
      //分配内存
    GetMem(NewEntry^.NextEntry, sizeof(TAddEntry));
    NewEntry := NewEntry^.NextEntry;   //指针移动
  end;
  //清空记录
  FillChar(NewEntry^, SizeOf(TAddEntry), 0);
  with NewEntry^ do begin //
    FaxName := FName;
    CoverName := CName;
    PhoneNumber := PNumber;
    NextEntry := nil;
  end;
  inc(AddsPending);
end;

procedure TsfMain.sfGetAddListEntry(var FName, CName, PNumber : String);
//
var
  TempEntry : PAddEntry;
begin
  if AddList = nil then
    exit;

  TempEntry := AddList;
  AddList := AddList^.NextEntry;
  with TempEntry^ do begin
    FName := FaxName;
    CName := CoverName;
    PNumber := PhoneNumber;
  end;
  FreeMem(TempEntry, SizeOf(TAddEntry));
  dec(AddsPending);
end;

procedure TsfMain.sfAddPrim;
 //显示添加的对话框
var
  S : String;
  FName, CName, PNumber : String;
begin
   AddsInProgress := True;
   sfFaxList.flAction.Caption := '添加';
  while AddsPending > 0 do begin
    //显示
    with sfFaxList do begin
      sfGetAddListEntry(FName, CName, PNumber);
      FaxName := FName;
      CoverName := CName;
      PhoneNumber := PNumber;
    end;

    //如果要添加的不为空即添加
    if (sfFaxList.ShowModal = mrOK) and
       (sfFaxList.PhoneNumber <> '') and
       (sfFaxList.FaxName <> '') then begin
      //显示在列表中
      S := sfFaxList.PhoneNumber + '^' + sfFaxList.FaxName;
      if sfFaxList.CoverName <> '' then
        S := S + '^' + sfFaxList.CoverName;
      FaxList.Add(S);

      //
      S := Format('%-20S %-20S %-20S',
                  [LimitS(sfFaxList.PhoneNumber, 20),
                   LimitS(sfFaxList.FaxName, 20),
                   LimitS(sfFaxList.CoverName, 20)]);
      sfFaxListBox.Items.Add(S);
    end;
  end;

  AddsInProgress := False;
end;

procedure TsfMain.sfAddClick(Sender: TObject);
//添加要发送的文件
begin
  sfAppendAddList('', '', '');
  sfAddPrim;
end;

procedure TsfMain.sfAddFromPrinterDriver(var Message: TMessage);
// 通过打印驱动程序添加请求信息
var
  JobID  : Word;
  KeyBuf : array[0..8] of Char;
  zFName : array[0..255] of Char;
begin
  //
  {The message received from the printer driver has a job identifier
   in the wParam field.  This job identifier points to an entry in the
   SendFax.Ini file which the printer driver has added.  As SendFax
   handles each message, it should delete that job entry from the Ini
   file and queue the job for display in the Add dialog.}
  with Message do begin
    JobID := wParam;
    StrCopy(KeyBuf, 'Job');
    KeyBuf[3] := Chr(Lo(JobID));
    KeyBuf[4] := #0;
    GetPrivateProfileString('FaxJobs', KeyBuf, '', zFName, sizeof(zFName),
                            'SENDFAX.INI');
   WritePrivateProfileString('FaxJobs', KeyBuf, nil, 'SENDFAX.INI');
  end;

  sfAppendAddList(StrPas(zFName), '', '');

  if not AddsInProgress then
    sfAddPrim;
end;

procedure TsfMain.sfAddFromCmdLine;
//从命令行中发送请求信息
begin
  if uppercase(ParamStr(1)) = '/F' then begin
    sfAppendAddList(ParamStr(2), '', '');