sendfax0.pas

收发传真程序

    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.