main.pas

该源代码是有关modem 拨号

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ComCtrls, TAPILine, StdCtrls, ExtCtrls, Buttons;

type
  TformMain = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Modem1: TMenuItem;
    About1: TMenuItem;
    Exit1: TMenuItem;
    Options1: TMenuItem;
    Howtodial1: TMenuItem;
    Configuration1: TMenuItem;
    N1: TMenuItem;
    Panel1: TPanel;
    toWrite: TEdit;
    OpenDialog: TOpenDialog;
    SaveDialog1: TSaveDialog;
    TAPILine1: TTAPILine;
    Panel2: TPanel;
    StatusListBox: TListBox;
    GroupBox1: TGroupBox;
    PhoneNumber: TEdit;
    sbDial: TSpeedButton;
    GroupBox2: TGroupBox;
    sbSendFile: TSpeedButton;
    sbReceiveFile: TSpeedButton;
    GroupBox3: TGroupBox;
    sbResume: TSpeedButton;
    sbStop: TSpeedButton;
    GroupBox4: TGroupBox;
    sbDisconnect: TSpeedButton;
    sbOpenLine: TSpeedButton;
    Send: TButton;
    Label1: TLabel;
    sbRead: TSpeedButton;
    procedure Exit1Click(Sender: TObject);
    procedure Options1Click(Sender: TObject);
    procedure Howtodial1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TAPILine1Connection(Sender: TObject);
    procedure Configuration1Click(Sender: TObject);
    procedure Connect1Click(Sender: TObject);
    procedure Disconnect1Click(Sender: TObject);
    procedure toWriteEnter(Sender: TObject);
    procedure OnDissconectClick(Sender: TObject);
    procedure Sendfile1Click(Sender: TObject);
    procedure Receivefile1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TAPILine1DropCall(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure TAPILine1NewData(Sender: TObject);
    procedure sbOpenLineClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TAPILine1CallerID(Sender: TObject; ID, IDName: String);
    procedure TAPILine1StatusMessage(Severity:TStatusMessageSeverity; ErrorID: Cardinal;
      MsgStr: String);
    procedure StatusListBoxClick(Sender: TObject);
    procedure SendClick(Sender: TObject);
    procedure TAPILine1Open(Sender: TObject);
    procedure sbStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMain: TformMain;

implementation

uses Options, About;

{$R *.DFM}

procedure TformMain.Exit1Click(Sender: TObject);
begin
    Close;
end;

procedure TformMain.Options1Click(Sender: TObject);
begin
    if formOptions = nil Then
       formOptions := TformOptions.Create (self);
    formOptions.ShowModal;

    sbOpenLine.Click;
end;

procedure TformMain.Howtodial1Click(Sender: TObject);
begin
    TAPILine1.TranslateDialog;
end;

procedure TformMain.FormCreate(Sender: TObject);
begin
    Options1Click (nil);
end;

procedure TformMain.TAPILine1Connection(Sender: TObject);
begin
   sbOpenLine.Enabled := False;
   sbDisconnect.Enabled := True;
   sbDial.Enabled := False;
   sbSendfile.Enabled := True;
   sbReceivefile.Enabled := True;
   sbStop.Enabled := True;
   sbResume.Enabled := True;
   sbRead.Enabled := True;

   sbResume.Click;
end;

procedure TformMain.Configuration1Click(Sender: TObject);
begin
   TAPILine1.ConfigDialog;
end;

procedure TformMain.Connect1Click(Sender: TObject);
begin
   TAPILine1.MakeCall(PhoneNumber.Text);
end;

procedure TformMain.Disconnect1Click(Sender: TObject);
begin
   TAPILine1.Close;

   sbOpenLine.Enabled := True;
   sbDisconnect.Enabled := False;
   sbDial.Enabled := False;
   sbSendfile.Enabled := False;
   sbReceivefile.Enabled := False;
   sbStop.Enabled := False;
   sbResume.Enabled := False;
   sbRead.Enabled := False;
end;

procedure TformMain.toWriteEnter(Sender: TObject);
begin
    TAPILine1.Write (toWrite.Text);
    toWrite.Text := '';
end;

procedure TformMain.OnDissconectClick(Sender: TObject);
begin
    sbDisconnect.Enabled := False;
    sbOpenLine.Enabled := True;
    sbDial.Enabled := False;
end;

procedure TformMain.Sendfile1Click(Sender: TObject);
Var
  F: file of byte;
  S: string;
  Buf: array[0..2049] of Char;
  NumRead, size: longint;
  timeToWrite, beforeWriting, afterWriting : DWORD;
  sFile, sResponse: string;
  len, i: integer;
begin
    if OpenDialog.Execute then          { Display Open dialog box }
       begin
       sbStop.Click;

       AssignFile(F, OpenDialog.FileName);   { File selected in dialog box }
       Reset(F);
       size := FileSize(F);
       timeToWrite := 0;
       sFile := Copy (ExtractFileName (OpenDialog.FileName), 1, 12);

       sResponse := 'sendFILE:'+sFile;
       len := Length (sResponse);
       for i := len to 20 do sResponse := sResponse + ' ';
       TAPILine1.Write (sResponse+NEW_LINE); //23

       sResponse := TAPILine1.Read (22);
       if (sResponse <> 'sendFILE:OK         '+NEW_LINE) Then
          ShowMessage (sResponse + ' - bad SendFile response.');
       size := 0;

       while True do
            Begin
            BlockRead (F, Buf, 2048, NumRead);

            if NumRead = 0 Then
               Break;

            sResponse := 'FILELeng:'+IntToStr (NumRead);
            len := Length (sResponse);
            for i := len to 19 do sResponse := sResponse + ' ';
            if (Length (sResponse) <> 20) Then ShowMessage ('Bad length');
            TAPILine1.Write (sResponse+NEW_LINE); //22

            buf[NumRead] := Chr (0);

            if TAPILine1.WriteLargeData (@buf, NumRead) = False Then ShowMessage ('Write failed');

            size := size + NumRead;
            StatusBar1.Panels[0].text := 'Bytes has been written: '+IntToStr (size);
            Application.ProcessMessages;

            sResponse := TAPILine1.Read (22);
            if (sResponse <> 'FILELeng:OK         '+NEW_LINE) Then
               ShowMessage (sResponse + ' - bad File Length response.');
            End;

       CloseFile (F);
//       StatusBar1.Panels[0].text := 'Bytes has been written: '+IntToStr (size);
       End;
end;

procedure TformMain.Receivefile1Click(Sender: TObject);
Var
  Buf: array[0..2049] of Char;
  F: file of byte;
  timeToWrite, beforeWriting, afterWriting : DWORD;
  size, len:  longint;
  sResponse, FileName, strBlockLen: string;
begin
       sbStop.Click;

       sResponse := TAPILine1.Read (23); //23
       FileName := Copy (sResponse, pos (':', sResponse)+1, pos ('.', sResponse)-pos (':', sResponse)-1);
       TAPILine1.Write ('sendFILE:OK         '+NEW_LINE);

       AssignFile (F, FileName+'.sav');   { File selected in dialog box }
       Rewrite(F);
       timeToWrite := 0;
       size := 0;

       While True do
           Begin
           sResponse := TAPILine1.Read (22); //22
           strBlockLen := Copy (sResponse, pos (':', sResponse)+1, pos (' ', sResponse)-pos (':', sResponse));
           len := StrToInt (Trim (strBlockLen));

           beforeWriting := GetTickCount;
           TAPILine1.ReadLargeData (@buf, len);
           afterWriting := GetTickCount;

           Inc (timeToWrite, afterWriting-beforeWriting);
           Inc (size, len);
           BlockWrite (F, Buf, len);

           TAPILine1.Write ('FILELeng:OK         '+NEW_LINE);
           if len <> 2048 Then break;

           StatusBar1.Panels[0].text := 'Bytes has been read: '+IntToStr (size)+ '  Time elapsed: '+IntToStr (timeToWrite)+' ml.sec.';
           Application.ProcessMessages;
           End;

       size := FileSize(F);
       CloseFile (F);
       StatusBar1.Panels[0].text := 'Bytes has been read: '+IntToStr (size)+ '  Time elapsed: '+IntToStr (timeToWrite)+' ml.sec.';
end;

procedure TformMain.FormDestroy(Sender: TObject);
begin
    TAPILine1.free;
end;

procedure TformMain.TAPILine1DropCall(Sender: TObject);
begin
    TAPILine1.Close;
end;

procedure TformMain.About1Click(Sender: TObject);
begin
    AboutBox := TAboutBox.Create (self);
    AboutBox.ShowModal;
    AboutBox.Free;
end;

procedure TformMain.TAPILine1NewData(Sender: TObject);
begin
    StatusListBoxClick(nil);
end;

procedure TformMain.sbOpenLineClick(Sender: TObject);
begin
   TAPILine1.Open;
End;

procedure TformMain.Button1Click(Sender: TObject);
begin
    TAPILine1.ResumeWaitingNewData;
    sbResume.Enabled := False;
    sbStop.Enabled := True;
end;

procedure TformMain.TAPILine1CallerID(Sender: TObject; ID, IDName: String);
begin
    StatusBar1.Panels[2].Text:=IDNAme+', '+ID;
end;

procedure TformMain.TAPILine1StatusMessage(Severity:TStatusMessageSeverity; ErrorID: Cardinal;
  MsgStr: String);
Var
  Msg : string;
begin
  Msg := '<'+DateTimeToStr (Now)+'> ';
  case Severity of
    smsError: StatusListBox.Items.Add(Msg+'ERROR: '+MsgStr);
    smsDebug: StatusListBox.Items.Add(Msg+MsgStr);
    smsStatus:
      Begin
        StatusListBox.Items.Add(Msg+MsgStr);
        StatusBar1.Panels[0].Text := MsgStr;
      end;
    smsClock: StatusBar1.Panels[1].Text := MsgStr;
  end;
end;

procedure TformMain.StatusListBoxClick(Sender: TObject);
Var
   s: string;
begin
  s := TAPILine1.Read (0);
  if s<>'' then
    StatusListBox.Items.Add (s);
end;

procedure TformMain.SendClick(Sender: TObject);
begin
   toWriteEnter(nil);
end;

procedure TformMain.TAPILine1Open(Sender: TObject);
begin
   sbOpenLine.Enabled := False;
   sbDisconnect.Enabled := True;
   sbDial.Enabled := True;
end;

procedure TformMain.sbStopClick(Sender: TObject);
begin
   TAPILine1.bStopWaitingNewData := True;
   sbResume.Enabled := True;
   sbStop.Enabled := False;
end;

end.