www.pudn.com > sendfax.zip > SENDFAX0.PAS

{**********************************************************} 
{*                     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), '', ''); 
    if not AddsInProgress then 
      sfAddPrim; 
  end; 
end; 
 
procedure TsfMain.ApdSendFax1FaxNext(CP: TObject; 
                                     var ANumber, AFileName, 
                                     ACoverName: TPassString); 
//下一个要发的传真文件 
var 
  S : String; 
  CaretPos : Byte; 
begin 
  if FaxList.Count = 0 then Exit; 
  try 
    S := FaxList[FaxIndex]; 
    CaretPos := Pos('^', S); 
    ANumber := Copy(S, 1, CaretPos-1); 
    S := Copy(S, CaretPos+1, 255); 
    CaretPos := Pos('^', S); 
    if CaretPos = 0 then begin 
      AFileName := S; 
      ACoverName := ''; 
    end else begin 
      AFileName := Copy(S, 1, CaretPos-1); 
      ACoverName := Copy(S, CaretPos+1, 255); 
    end; 
    Inc(FaxIndex); 
  except 
    ANumber := ''; 
    AFileName := ''; 
    ACoverName := ''; 
  end; 
end; 
 
procedure TsfMain.ApdSendFax1FaxFinish(CP: TObject; ErrorCode: Integer); 
//显示结束信息 
begin 
  ShowMessage('结束: ' + ErrorMsg(ErrorCode)); 
  if ApdComPort1.TapiMode = tmOn then 
    if ApdTapiDevice1.CancelCall then 
       //立刻取消呼叫,清标志 
      InProgress := False 
    else 
      //等待执行OnTapiPortClose进行端口关闭 
  else begin 
      //未使用TAPI，直接关闭端口 
    ApdComPort1.Open := False; 
    InProgress := False; 
  end; 
end; 
 
procedure TsfMain.sfExitClick(Sender: TObject); 
//退出应用程序 
var 
  TempEntry : PAddEntry; 
begin 
  while AddList <> nil do begin 
    TempEntry := AddList; 
    AddList := AddList^.NextEntry; 
    FreeMem(TempEntry, SizeOf(TAddEntry)); 
  end; 
  Close; 
end; 
 
procedure TsfMain.sfModifyClick(Sender: TObject); 
//修改已加入的发送列表 
var 
  SaveIndex : Integer; 
  CPos : Word; 
  S : String; 
begin 
  if InProgress then begin 
    MessageBeep(0); 
    Exit; 
  end; 
  if sfFaxListBox.ItemIndex = -1 then 
    Exit; 
 
   sfFaxList.flAction.Caption := '修改'; 
 
  //从FaxList中获取列表 
  SaveIndex := sfFaxListBox.ItemIndex; 
  S := FaxList[SaveIndex]; 
  CPos := Pos('^', S); 
  sfFaxList.PhoneNumber := Copy(S, 1, CPos-1); 
  S := Copy(S, CPos+1, 255); 
  CPos := Pos('^', S); 
  if CPos = 0 then 
    sfFaxList.FaxName := S 
  else begin 
    sfFaxList.FaxName := Copy(S, 1, CPos-1); 
    sfFaxList.CoverName := Copy(S, CPos+1, 255); 
  end; 
 
  //显示对话框 
  if sfFaxList.ShowModal = mrOK then begin 
   //修改列表 
     S := sfFaxList.PhoneNumber + '^' + sfFaxList.FaxName; 
    if sfFaxList.CoverName <> '' then 
      S := S + '^' + sfFaxList.CoverName; 
    FaxList.Strings[SaveIndex] := S; 
 
   // 
    S := Format('%-20S %-20S %-20S', 
                [LimitS(sfFaxList.PhoneNumber, 20), 
                 LimitS(sfFaxList.FaxName, 20), 
                 LimitS(sfFaxList.CoverName, 20)]); 
    sfFaxListBox.Items[SaveIndex] := S; 
  end; 
end; 
 
procedure TsfMain.sfDeleteClick(Sender: TObject); 
//删除要发送的传真文件 
var 
  Index : Word; 
begin 
  if InProgress then begin 
    MessageBeep(0); 
    Exit; 
  end; 
 
  if sfFaxListBox.ItemIndex <> -1 then begin 
    Index := sfFaxListBox.ItemIndex; 
    sfFaxListBox.Items.Delete(Index); 
    FaxList.Delete(Index); 
  end; 
end; 
 
procedure TsfMain.ApdSendFax1FaxLog(CP: TObject; LogCode: TFaxLogCode); 
//产生日志 
begin 
  if LogCode = lfaxTransmitOK then begin 
    Dec(FaxIndex); 
    sfFaxListBox.Items.Delete(FaxIndex); 
    FaxList.Delete(FaxIndex); 
  end; 
end; 
 
procedure TsfMain.sfFaxClassClick(Sender: TObject); 
//用另一种类型 
//传真类型，这要看FaxMode的类型，看支持哪一类, 
//通常应用程序应该用最高的支持fcClass2_0 
//fcClass2.fcClass1 
begin 
  ApdSendFax1.FaxClass := TFaxClass(sfFaxClass.ItemIndex+1); 
end; 
 
procedure TsfMain.sfDialAttemptsChange(Sender: TObject); 
//最多的尝试连接次数 
begin 
  try 
    ApdSendFax1.DialAttempts := StrToInt(sfDialAttempts.Text); 
  except 
  end; 
end; 
 
procedure TsfMain.sfRetryWaitChange(Sender: TObject); 
//最大的等待时间 
begin 
  try 
    ApdSendFax1.DialRetryWait := StrToInt(sfRetryWait.Text); 
  except 
  end; 
end; 
 
procedure TsfMain.sfStationIDChange(Sender: TObject); 
//设置新工作站ID 
begin 
  ApdSendFax1.StationID := sfStationID.Text; 
end; 
 
procedure TsfMain.sfDialPrefixChange(Sender: TObject); 
//设置新的拨号前缀 
begin 
  ApdSendFax1.DialPrefix := sfDialPrefix.Text; 
end; 
 
procedure TsfMain.sfModemInitChange(Sender: TObject); 
//设置新的Modem初始化字符串 
begin 
  ApdSendFax1.ModemInit := sfModemInit.Text; 
end; 
 
procedure TsfMain.sfHeaderChange(Sender: TObject); 
//设置新的传真文件头 
begin 
  ApdSendFax1.HeaderLine := sfHeader.Text; 
end; 
 
procedure TsfMain.sfSelectComPortClick(Sender: TObject); 
//选择设备 
begin 
  ApdTapiDevice1.SelectDevice; 
end; 
 
procedure TsfMain.ApdTapiDevice1TapiPortOpen(Sender: TObject); 
begin 
  //利用TAPI设置并打开端口，开始传真会话 
  if Current=0 then 
   ApdSendFax1.StartTransmit 
  else 
   ApdReceiveFax1.StartReceive; 
end; 
 
procedure TsfMain.ApdTapiDevice1TapiPortClose(Sender: TObject); 
begin 
  InProgress := False; 
end; 
 
procedure TsfMain.HdrFontBtnClick(Sender: TObject); 
//设置字体 
begin 
  FontDialog1.Font.Assign(ApdSendFax1.EnhHeaderFont); 
  if FontDialog1.Execute then 
    ApdSendFax1.EnhHeaderFont.Assign(FontDialog1.Font); 
end; 
 
procedure TsfMain.CvrFontBtnClick(Sender: TObject); 
begin 
  FontDialog1.Font.Assign(ApdSendFax1.EnhFont); 
  if FontDialog1.Execute then 
    ApdSendFax1.EnhFont.Assign(FontDialog1.Font); 
end; 
 
procedure TsfMain.rfSelectPortClick(Sender: TObject); 
begin 
  ApdTapiDevice1.SelectDevice; 
end; 
 
procedure TsfMain.rfReceiveFaxesClick(Sender: TObject); 
begin 
if not InProgress then begin 
    InProgress := True; 
    ApdReceiveFax1.FaxClass := TFaxClass(rfFaxClass.ItemIndex+1); 
    ApdReceiveFax1.DestinationDir := rfDirectory.Text; 
    ApdReceiveFax1.ModemInit := rfModemInit.Text; 
 
    if (ApdComPort1.TapiMode = tmOn) or 
       ((ApdComPort1.TapiMode = tmAuto) and 
        (ApdTapiDevice1.SelectedDevice <> '')) then begin 
      {Tell TAPI to configure and open the port} 
      ApdTapiDevice1.ConfigAndOpen; 
    end else begin 
      {Open the port and start receiving} 
      ApdComPort1.Open := True; 
      ApdReceiveFax1.StartReceive; 
    end; 
  end else 
    MessageBeep(0); 
end; 
 
procedure TsfMain.rfExitClick(Sender: TObject); 
begin 
  Close; 
end; 
 
procedure TsfMain.rfFaxClassClick(Sender: TObject); 
begin 
 ApdReceiveFax1.FaxClass := TFaxClass(rfFaxClass.ItemIndex+1); 
end; 
 
procedure TsfMain.rfDirectoryChange(Sender: TObject); 
begin 
  ApdReceiveFax1.DestinationDir := rfDirectory.Text; 
end; 
 
procedure TsfMain.rfModemInitChange(Sender: TObject); 
begin 
  ApdReceiveFax1.ModemInit := rfModemInit.Text; 
end; 
 
procedure TsfMain.rfNameStyleClick(Sender: TObject); 
begin 
  ApdReceiveFax1.FaxNameMode := TFaxNameMode(rfNameStyle.ItemIndex+1); 
end; 
 
procedure TsfMain.PageControl1Change(Sender: TObject); 
begin 
 if PageControl1.ActivePageIndex=0 then 
 begin 
   Current:=0; 
   ApdFaxStatus1.Fax:=ApdSendFax1; 
   ApdFaxLog1.Fax:=ApdSendFax1; 
 end 
 else 
 begin 
   Current:=1; 
   ApdFaxStatus1.Fax:=ApdReceiveFax1; 
   ApdFaxLog1.Fax:=ApdReceiveFax1; 
 end; 
end; 
 
procedure TsfMain.ApdReceiveFax1FaxError(CP: TObject; ErrorCode: Integer); 
begin 
 ShowMessage('Fax error: ' + ErrorMsg(ErrorCode)); 
end; 
 
procedure TsfMain.ApdReceiveFax1FaxFinish(CP: TObject; ErrorCode: Integer); 
begin 
 if ApdComPort1.TapiMode = tmOn then 
    if ApdTapiDevice1.CancelCall then 
      {Call cancelled immediately, clear InProgress flag} 
      InProgress := False 
    else 
      {CancelCall proceeding in background, waiting for OnTapiPortClose} 
  else begin 
    {Not using TAPI, just close the port and clear the InProgress flag} 
    ApdComPort1.Open := False; 
    InProgress := False; 
  end; 
end; 
 
procedure TsfMain.ApdReceiveFax1FaxLog(CP: TObject; LogCode: TFaxLogCode); 
var 
  FSize : LongInt; 
  F     : File; 
  S     : String; 
begin 
  if LogCode = AdFax.lfaxReceiveOK then begin 
    {Get the file size} 
    AssignFile(F, ApdReceiveFax1.FaxFile); 
    Reset(F, 1); 
    FSize := FileSize(F); 
    CloseFile(F); 
 
    {Add an entry to the displayed list box of received files} 
    S := Format('%-25S %-20S %-20S', 
                [LimitS(ExtractFileName(ApdReceiveFax1.FaxFile), 20), 
                 IntToStr(FSize), 
                 DateTimeToStr(Now)]); 
    rfReceiveList.Items.Add(S); 
  end; 
end; 
 
procedure TsfMain.BitBtn1Click(Sender: TObject); 
var 
  Dir: string; 
begin 
  Dir := ExtractFilePath(Application.ExeName); 
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0) then 
    rfDirectory.text:= Dir; 
end; 
 
end.