home *** CD-ROM | disk | FTP | other *** search
-
- program testbed;
-
- {$R testbed.RES}
-
- uses wincrt, WObjects, WinTypes, WinProcs, strings, StdDlgs, StdWnds,
- dialunit;
-
- const
- IO_AREA_SIZE = 65000;
- CURSOR_CHAR = '|';
- cm_specparam = 101;
- cm_establink = 102;
- cm_hangup = 103;
- cm_callbbs = 104;
- cm_xmodemdown= 105;
- cm_xmodemup = 106;
- cm_xmod1kdown= 107;
- cm_xmod1kup = 108;
- cm_ymodemdown= 109;
- cm_ymodemup = 110;
- cm_interrupt = 111;
- cm_addresponse=112;
- cm_linktoport =113;
-
- cm_exit = 001;
-
- cm_download = 201;
- cm_upload = 202;
- cm_movedown = 203;
- cm_moveup = 204;
- cm_update = 205;
- cm_mailupdate= 206;
-
- cm_zipserver = 301;
- cm_zipclient = 302;
-
- cm_unzipserver = 401;
- cm_unzipclient = 402;
-
- cm_runserver = 501;
- cm_runclient = 502;
- cm_lnchserver= 503;
- cm_lnchclient= 504;
-
- cm_delServer = 601;
- cm_delClient = 602;
-
- cm_UseHelp = 905;
- cm_HelpAbout = 999;
-
- cm_DialupStatus = 145;
- cm_DialupBanner = 146;
- cm_DialupBytes = 147;
- cm_DialupElapsed = 148;
- cm_DialupBPS = 149;
- cm_DialupPercent = 150;
- cm_CommandCompleted = 151;
- cm_ZipStatus = 152;
-
- cm_CommNotify = 160;
- cm_EventNotify = 161;
-
- id_messagearea = 101;
- id_notifyarea = 902;
-
- type
- TTestBedApp = object(TApplication)
- procedure InitMainWindow; virtual;
- procedure InitInstance; virtual;
- end;
-
- pMultiFieldDlg = ^TMultiFieldDlg;
- TMultiFieldDlg= object(Tdialog)
- NumFields:integer;
- Chk:pcheckbox;
- procedure SetupWindow; virtual;
- procedure EndDlg(ARetValue: Integer); virtual;
- constructor Init(AParent: PWindowsObject; AName: PChar;aNumFields:integer);
- end;
-
- PStatusWindow= ^TStatusWindow;
- TStatusWindow = object(TDlgWindow)
- MessagesArea:plistbox;
- NotificationsArea:plistbox;
- MyParent : pWindow;
- constructor Init(AParent: PWindowsObject;
- AName: PChar);
- procedure SetupWindow; virtual;
- procedure WMSetFocus(var Msg: TMessage);
- virtual WM_First + WM_setfocus;
- end;
-
- PTTestBedWindow = ^TTestBedWindow;
- TTestBedWindow = object(TWindow)
- MyScroller : pscroller;
- StatusWindow : pStatusWindow;
- IORow,IOLine:integer;
-
- IOWindow : pdialog;
- IOChannelOpen:boolean;
- CallInProgress:boolean;
- HangupRequested:boolean;
- NumLines :word;
- LinesPerScreen:word;
- LastKey:char;
- IOArea :pchar;
- IOAreaIndex :word;
- CommandSerialNumber:word;
-
-
- constructor Init(AParent: PWindowsObject; ATitle: PChar);
- destructor Done; virtual;
- procedure SetupWindow; virtual;
- procedure GetWindowClass(var AWndClass:TWndCLass); virtual;
-
- procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
- function CanClose: boolean; virtual;
- procedure WMChar(var Msg: TMessage);
- virtual WM_First + WM_char;
- function RunDialog(Title,Label1,Label2,Label3:string;
- NumFields:integer):boolean; virtual;
- procedure PrepNotifications; virtual;
-
- (* Responses to user input... *)
-
- {File...}
- procedure FileExit(var Msg: TMessage);
- virtual cm_First + cm_exit;
-
- {Connection...}
- procedure SpecParam(var Msg: TMessage);
- virtual cm_First + cm_specparam;
- procedure EstabLink(var Msg: TMessage);
- virtual cm_First + cm_establink;
- procedure AddAutoResponse(var Msg: TMessage);
- virtual cm_First + cm_addresponse;
- procedure CallBBS(var Msg: TMessage);
- virtual cm_First + cm_callbbs;
- procedure LinkToPort(var Msg: TMessage);
- virtual cm_First + cm_linktoport;
- procedure Hangup(var Msg: TMessage);
- virtual cm_First + cm_hangup;
-
- {Transfer...}
- procedure DownLoad(var Msg: TMessage);
- virtual cm_First + cm_download;
- procedure UpLoad(var Msg: TMessage);
- virtual cm_First + cm_upload;
- procedure MoveDown(var Msg: TMessage);
- virtual cm_First + cm_movedown;
- procedure MoveUp(var Msg: TMessage);
- virtual cm_First + cm_moveup;
- procedure UpdateClient(var Msg: TMessage);
- virtual cm_First + cm_update;
- procedure UpdateEZMail(var Msg: TMessage);
- virtual cm_First + cm_mailupdate;
-
- {Zip...}
- procedure ZipServer(var Msg: TMessage);
- virtual cm_First + cm_zipserver;
- procedure ZipClient(var Msg: TMessage);
- virtual cm_First + cm_zipclient;
- procedure UnZipServer(var Msg: TMessage);
- virtual cm_First + cm_unzipserver;
- procedure UnZipClient(var Msg: TMessage);
- virtual cm_First + cm_unzipclient;
-
- {Execute...}
- procedure RunServer(var Msg: TMessage);
- virtual cm_First + cm_runserver;
- procedure RunClient(var Msg: TMessage);
- virtual cm_First + cm_runclient;
- procedure LnchServer(var Msg: TMessage);
- virtual cm_First + cm_lnchserver;
- procedure LnchClient(var Msg: TMessage);
- virtual cm_First + cm_lnchclient;
-
- {Delete...}
- procedure DelServer(var Msg: TMessage);
- virtual cm_First + cm_delserver;
- procedure DelClient(var Msg: TMessage);
- virtual cm_First + cm_delclient;
-
- {X-Ymodem}
- procedure XmodemDownload(var Msg: TMessage);
- virtual cm_First + cm_xmodemdown;
- procedure XmodemUpload(var Msg: TMessage);
- virtual cm_First + cm_xmodemup;
- procedure Xmodem1KDownload(var Msg: TMessage);
- virtual cm_First + cm_xmod1kdown;
- procedure Xmodem1KUpload(var Msg: TMessage);
- virtual cm_First + cm_xmod1kup;
- procedure YmodemDownload(var Msg: TMessage);
- virtual cm_First + cm_ymodemdown;
- procedure YmodemUpload(var Msg: TMessage);
- virtual cm_First + cm_ymodemup;
- procedure InterruptTransfer(var Msg: TMessage);
- virtual cm_First + cm_interrupt;
-
- {Help}
- procedure UseHelp(var Msg: TMessage);
- virtual cm_First + cm_UseHelp;
- procedure HelpAbout(var Msg: TMessage);
- virtual cm_First + cm_HelpAbout;
-
- (* Responses to EZdialup messages... *)
- procedure NewDialupStatus(var Msg:Tmessage);
- virtual wm_user + cm_DialupStatus;
- procedure NewDialupBanner(var Msg:Tmessage);
- virtual wm_user + cm_DialupBanner;
- procedure NewDialupBytes(var Msg:Tmessage);
- virtual wm_user + cm_DialupBytes;
- procedure NewDialupElapsed(var Msg:Tmessage);
- virtual wm_user + cm_DialupElapsed;
- procedure NewDialupBPS(var Msg:Tmessage);
- virtual wm_user + cm_DialupBPS;
- procedure NewDialupPercent(var Msg:Tmessage);
- virtual wm_user + cm_DialupPercent;
- procedure CommandCompleted(var Msg:Tmessage);
- virtual wm_user + cm_CommandCompleted;
- procedure NewZipStatus(var Msg:Tmessage);
- virtual wm_user + cm_ZipStatus;
-
- procedure SerialIONotify(var Msg:Tmessage);
- virtual wm_user + cm_commnotify;
- procedure EventNotify(var Msg:Tmessage);
- virtual wm_user + cm_eventnotify;
-
-
- end;
-
-
- var
- FieldResults:array[1..10] of string;
- FieldLabels:array[1..10] of string;
- DialogTitle:string;
- CheckBoxChecked:boolean;
- TextHeight :word;
-
-
-
- Procedure AddNul(var s:string);
- begin
- (* Make pascal string null-terminated *)
- s[length(s)+1] := chr(0);
- end;
-
-
-
- constructor TStatusWindow.Init(AParent: PWindowsObject; AName: PChar);
- begin
- TdlgWindow.init(AParent,ANAme);
- MyParent := pointer(aparent);
- MessagesArea := New(Plistbox, InitResource(@self, id_messagearea));
- NotificationsArea := New(Plistbox, InitResource(@self, id_notifyarea));
- end;
-
-
- procedure TStatusWindow.SetupWindow;
- var s:string;
- ParentRect,winrect:trect;
- begin
- TdlgWindow.SetupWindow;
- end;
-
-
- procedure TStatusWindow.WMSetFocus(var Msg: TMessage);
- begin
- defwndproc(msg);
- Setfocus(parent^.hwindow);
- end;
-
- constructor TMultiFieldDlg.init(AParent: PWindowsObject; AName: PChar;aNumFields:integer);
- begin
- tdialog.init(aparent,aname);
- NumFields := ANumFields;
- chk := new(pcheckbox,InitResource(@self, 150));
- end;
-
- procedure TMultiFieldDlg.SetupWindow;
- var i:integer;
- begin
- tdialog.Setupwindow;
-
- for i := 1 to NumFields do addnul(FieldResults[i]);
-
- for i := 1 to NumFields do
- SetDlgItemText(hwindow,100+i,@FieldResults[i][1]);
-
- for i := 1 to NumFields do
- if FieldLabels[i] <> ''
- then begin
- Addnul(FieldLabels[i]);
- SetDlgItemText(hwindow,200+i,@FieldLabels[i][1]);
- end;
-
- addnul(DialogTitle);
- SetWindowText(hwindow,@DialogTitle[1]);
-
- chk^.check;
-
- end;
-
- procedure TMultiFieldDlg.EndDlg(ARetValue: Integer);
- var i,j:integer;
- name:array[0..144] of char;
- s:string;
- begin
- i := ARetValue;
- if i = id_ok then begin
-
- for j := 1 to NumFields do begin
- GetDlgItemText(hwindow,100+j,name,144);
- s := strpas(name);
- if s = '' then begin
- i := 3;
- end
- else begin
- FieldResults[j] := s;
- addnul(FieldResults[j]);
- end;
- end;
- CheckBoxChecked := (chk^.Getcheck = 1);
- end;
- Tdialog.EndDlg(i);
-
- end;
-
- procedure TTestBedWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
- var
- oldfont:hfont;
- rect:trect;
- tm:ttextmetric;
- begin
- oldfont := SelectObject(PaintDC,GetStockObject(ANSI_FIXED_FONT));
- GetClientRect(hwindow,rect);
-
- rect.bottom := GetTextExtent(PaintDC,ioarea,ioareaindex+1);
-
- DrawText(paintdc,ioarea,ioareaindex+1,rect,0);
- if TextHeight = 0 then begin
- GetClientRect(hwindow,rect);
- GetTextMetrics(PaintDC,tm);
- TextHeight := tm.tmheight;
- LinesPerScreen := (rect.bottom-rect.top) div TextHeight;
- MyScroller^.SetUnits(1,textHeight);
- end;
- SelectObject(PaintDC,oldfont);
- end;
-
-
- function TTestBedWindow.CanClose: boolean;
- begin
- CanClose := true;
- if CallInProgress and (not HangupRequested) then begin
- MessageBox(getfocus,
- 'Run Connection|Hangup before exiting program',
- 'Can not terminate Testbed',0);
- canclose := false;
- end;
- end;
-
-
- procedure TTestBedWindow.WMChar(var Msg: TMessage);
- begin
- if not IOChannelOpen then begin
- exit;
- end;
- SendSerialByte(msg.wparam); {** APPDIAL.DLL **}
- Lastkey := chr(msg.wparam);
- defwndproc(msg);
- end;
-
-
- {File...}
- procedure TTestBedWindow.FileExit(var Msg: TMessage);
- begin
- PostMessage(hwindow,wm_close,0,0);
- end;
-
- {Connection...}
- procedure TTestBedWindow.SpecParam(var Msg: TMessage);
- var i:integer;
- begin
-
- FieldResults[1] := '9,555-1212';
- FieldResults[2] := 'COM2';
- FieldResults[3] := '19200,n,8,1';
- FieldResults[4] := 'ATZ';
- FieldResults[5] := 'AT E0 V1 X4 S0=0';
- FieldResults[6] := 'k:\ezdialup\someuser';
- FieldResults[7] := 'userpassword';
- FieldResults[8] := 'ezdialup.exe';
-
- for i := 1 to 8 do FieldLabels[i] := '';
-
- repeat
- (* Display dialog until no empty fields or Cancel pressed... *)
- i := Application^.ExecDialog(New(pMultiFieldDlg, Init(@Self, 'SessionSpecs',8)))
- until i <> 3;
- if i = 1 then begin
- (* Ok was pressed; give EZDialup its configuration... *)
- (* These routines MUST be executed before server-control *)
- (* commands are allowed*)
- SetDialingSequence(@FieldResults[1][1]); {** APPDIAL.DLL **}
- SetDialupCommPort(@FieldResults[2][1]); {** APPDIAL.DLL **}
- SetDialupCommConfig(@FieldResults[3][1]); {** APPDIAL.DLL **}
- SetModemInit1(@FieldResults[4][1]); {** APPDIAL.DLL **}
- SetModemInit2(@FieldResults[5][1]); {** APPDIAL.DLL **}
-
- SetDownloadBlockSize(4096); {** APPDIAL.DLL **}
- SetUploadBlockSize(4096); {** APPDIAL.DLL **}
- SetLinkUserPath(@FieldResults[6][1]); {** APPDIAL.DLL **}
- SetLinkUserPassword(@FieldResults[7][1]); {** APPDIAL.DLL **}
-
- SetExecutablePath(@FieldResults[8][1]); {** APPDIAL.DLL **}
-
- end;
-
- for i := 1 to 8 do FieldResults[i] := '';
- end;
-
- procedure TTestBedWindow.EstabLink(var Msg: TMessage);
- begin
- if CallInprogress then exit;
- CallInProgress := true;
- HangupRequested := false;
- EstablishDialupLink; {** APPDIAL.DLL **}
- end;
-
-
- procedure TTestBedWindow.AddAutoResponse(var Msg: TMessage);
- var s:string;
- begin
- if RunDialog('Add Auto-Response','Search String:','Response:','',99)
- then begin
- s := concat(FieldResults[1],' -> ',FieldResults[2]);
- if CheckBoxChecked then s := concat(s,' (plus CR)');
- addnul(s);
- with StatusWindow^.NotificationsArea^ do begin
- AddString(@s[1]);
- SetSelIndex(GetCount-1);
- end;
- end;
- end;
-
- procedure TTestBedWindow.PrepNotifications;
- var s,s2,s3:string;
- i,j,k:integer;
- AddCR:boolean;
- ThisCRC:word;
- P:ARRAY[0..144] OF CHAR;
- begin
- if StatusWindow^.NotificationsArea^.GetCount > 0 then
- for i := 1 to StatusWindow^.NotificationsArea^.GetCount do begin
- J := StatusWindow^.NotificationsArea^.getstring(p,i-1);
- s := strpas(p);
- j := pos('->',s);
- s2 := copy(s,1,j-2);
- s3 := copy(s,j+3,length(s));
- k := pos('(plus CR)',s3);
- AddCr := (k > 0);
- if k > 0
- then s3 := copy(s3,1,k-2);
- addnul(s2);
- if AddCR then s3 := concat(s3,chr(13));
- addnul(s3);
- SetupNotification(@s2[1],@s3[1],0,0); {** APPDIAL.DLL **}
- end;
- end;
-
- procedure TTestBedWindow.CallBBS(var Msg: TMessage);
- var s:string;
- begin
-
-
- if CallInprogress then exit;
- CallInProgress := true;
- HangupRequested := false;
- ioareaindex := 0;
- ioarea[0] := CURSOR_CHAR;
- ioarea[1] := chr(0);
- NumLines := 0;
-
- (*Examples:
- SetupNotification('login: ','my-id',0,0); {** APPDIAL.DLL **}
- SetupNotification('password: ','my-password',0,0); {** APPDIAL.DLL **}
- *)
-
- PrepNotifications;
- EstablishLinkAsTerminal; {** APPDIAL.DLL **}
-
- end;
-
- procedure TTestBedWindow.LinkToPort(var Msg: TMessage);
- begin
- if CallInprogress then exit;
- CallInProgress := true;
- HangupRequested := false;
- ioareaindex := 0;
- ioarea[0] := CURSOR_CHAR;
- ioarea[1] := chr(0);
- NumLines := 0;
-
- PrepNotifications;
- EstablishCommPortLink; {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.Hangup(var Msg: TMessage);
- begin
- if IOChannelOpen then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- end;
-
- HangupRequested := true;
- AbortSession; {** APPDIAL.DLL **}
- end;
-
- {Transfer...}
- procedure TTestBedWindow.Download(var Msg: TMessage);
- begin
- if RunDialog('Download A File','Server File','Client File','',2)
- then CommandSerialNumber
- := StartDownload(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.Upload(var Msg: TMessage);
- begin
- if RunDialog('Upload A File','Server File','Client File','',2)
- then CommandSerialNumber
- := StartUpLoad(@FieldResults[2][1],@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.MoveDown(var Msg: TMessage);
- var p:pchar;
- begin
- if RunDialog('Move File Down','Server File','Client File','',2)
- then CommandSerialNumber
- := StartMoveDown(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.MoveUp(var Msg: TMessage);
- var p:pchar;
- begin
- if RunDialog('Move File Up','Server File','Client File','',2)
- then CommandSerialNumber
- := StartMoveUp(@FieldResults[2][1],@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.UpdateClient(var Msg: TMessage);
- var p:pchar;
- begin
- if RunDialog('Update Client Directory Structure',
- 'Client Directory',
- 'Server Directory',
- 'Client Date File',3)
- then CommandSerialNumber
- := UpdateClientDirectory(@FieldResults[1][1],
- @FieldResults[2][1],
- @FieldResults[3][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.UpdateEZmail(var Msg: TMessage);
- var p:pchar;
- begin
- if RunDialog('Update EZMail','Server Mailbox','Client Directory','',2)
- then CommandSerialNumber
- := EZMailUpdate(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- {Zip...}
- procedure TTestBedWindow.ZipServer(var Msg: TMessage);
- begin
- if RunDialog('Zip Server File(s)','Target File','Source File(s)','',2)
- then CommandSerialNumber
- := ZipServerFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.ZipClient(var Msg: TMessage);
- begin
- if RunDialog('Zip Client File(s)','Target File','Source File(s)','',2)
- then CommandSerialNumber
- := ZipClientFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.UnZipServer(var Msg: TMessage);
- begin
- if RunDialog('Un-Zip Server File(s)','Source Zip File','Target Directory','',2)
- then CommandSerialNumber
- := UnZipServerFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.UnZipClient(var Msg: TMessage);
- begin
- if RunDialog('Un-Zip Client File(s)','Source Zip File','Target Directory','',2)
- then CommandSerialNumber
- := UnZipClientFile(@FieldResults[1][1],@FieldResults[2][1]); {** APPDIAL.DLL **}
- end;
-
- {Execute...}
- procedure TTestBedWindow.RunServer(var Msg: TMessage);
- begin
- if RunDialog('Run and Wait for Server Program','Program Path','','',1)
- then CommandSerialNumber
- := RunProgramOnServer(@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.RunClient(var Msg: TMessage);
- begin
- if RunDialog('Run and Wait for Client Program','Program Path','','',1)
- then CommandSerialNumber
- := RunProgramOnClient(@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.LnchServer(var Msg: TMessage);
- begin
- if RunDialog('Run and Forget Server Program','Program Path','','',1)
- then CommandSerialNumber
- := LaunchProgramOnServer(@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.LnchClient(var Msg: TMessage);
- begin
- if RunDialog('Run and Forget Client Program','Program Path','','',1)
- then CommandSerialNumber
- := LaunchProgramOnClient(@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- {Delete...}
- procedure TTestBedWindow.DelServer(var Msg: TMessage);
- begin
- if RunDialog('Delete File(s) on Server','File(s)','','',1)
- then CommandSerialNumber
- := DeleteFilesOnServer(@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.DelClient(var Msg: TMessage);
- begin
- if RunDialog('Delete File(s) on Client','File(s)','','',1)
- then CommandSerialNumber
- := DeleteFilesOnClient(@FieldResults[1][1]); {** APPDIAL.DLL **}
- end;
-
- {X-Ymodem}
- procedure TTestBedWindow.XmodemDownload(var Msg: TMessage);
- begin
- if RunDialog('Download File (X)','Local File Name','','',1)
- then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- StartTerminalDownload(@FieldResults[1][1],1); {** APPDIAL.DLL **}
- end;
-
- end;
-
- procedure TTestBedWindow.XmodemUpload(var Msg: TMessage);
- begin
- if RunDialog('Upload File (X)','Local File Name','','',1)
- then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- StartTerminalUpload(@FieldResults[1][1],1); {** APPDIAL.DLL **}
- end;
- end;
-
- procedure TTestBedWindow.Xmodem1KDownload(var Msg: TMessage);
- begin
- if RunDialog('Download File (1K)','Local File Name','','',1)
- then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- StartTerminalDownload(@FieldResults[1][1],2); {** APPDIAL.DLL **}
- end;
-
- end;
-
- procedure TTestBedWindow.Xmodem1KUpload(var Msg: TMessage);
- begin
- if RunDialog('Upload File (1K)','Local File Name','','',1)
- then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- StartTerminalUpload(@FieldResults[1][1],2); {** APPDIAL.DLL **}
- end;
- end;
-
- procedure TTestBedWindow.YmodemDownload(var Msg: TMessage);
- begin
- if RunDialog('Download File (Y)','Local File Name','','',1)
- then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- StartTerminalDownload(@FieldResults[1][1],3); {** APPDIAL.DLL **}
- end;
-
- end;
-
- procedure TTestBedWindow.InterruptTransfer(var Msg: TMessage);
- begin
- InterruptFileTransfer; {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.YmodemUpload(var Msg: TMessage);
- begin
- if RunDialog('Upload File (Y)','Local File Name','','',1)
- then begin
- ShowWindow(StatusWindow^.hwindow,sw_show);
- MyScroller^.ScrollTo(0,0);
- IOChannelOpen := false;
- StartTerminalUpload(@FieldResults[1][1],3); {** APPDIAL.DLL **}
- end;
- end;
-
- {Help}
- procedure TTestBedWindow.UseHelp(var Msg:TMessage);
- begin
- WinHelp(HWindow, 'EZDIALUP.HLP', 3, 0);
- end;
-
- procedure TTestBedWindow.HelpABout(var Msg:TMessage);
- var
- result:integer;
- begin
- Application^.ExecDialog(new(pdialog,init(@self,'help')));
- end;
-
- procedure TTestBedWindow.NewDialupStatus(var Msg:Tmessage);
- var p:pchar;
- s:string;
-
- begin
- p := pointer(msg.lparam);
- s := strpas(p);
- if (s = 'EZDialup Shutdown')
- or (s = 'EZDialup Load Failed')
- then CallInProgress := false;
-
- with StatusWindow^.MessagesArea^ do begin
- AddString(p);
- SetSelIndex(GetCount-1);
- end;
-
- end;
-
- procedure TTestBedWindow.NewDialupBanner(var Msg:Tmessage);
- begin
- SetDlgItemText(StatusWindow^.hwindow,100,pointer(msg.lparam));
- end;
-
- procedure TTestBedWindow.NewDialupBytes(var Msg:Tmessage);
- begin
- SetDlgItemText(StatusWindow^.hwindow,102,pointer(msg.lparam));
- end;
-
- procedure TTestBedWindow.NewDialupPercent(var Msg:Tmessage);
- begin
- SetDlgItemText(StatusWindow^.hwindow,103,pointer(msg.lparam));
- end;
-
- procedure TTestBedWindow.NewDialupBPS(var Msg:Tmessage);
- begin
- SetDlgItemText(StatusWindow^.hwindow,104,pointer(msg.lparam));
- end;
-
- procedure TTestBedWindow.NewDialupElapsed(var Msg:Tmessage);
- begin
- SetDlgItemText(StatusWindow^.hwindow,105,pointer(msg.lparam));
- end;
-
- procedure TTestBedWindow.CommandCompleted(var Msg:Tmessage);
- var s,s2:string;
- begin
- s := strpas(pointer(msg.lparam));
- str(msg.wparam,s2);
- s := concat('Completed command: ',s2,' - ',s);
- addnul(s);
- with StatusWindow^.MessagesArea^ do begin
- AddString(@s[1]);
- SetSelIndex(GetCount-1);
- end;
- end;
-
- procedure TTestBedWindow.NewZipStatus(var Msg:Tmessage);
- begin
- SetDlgItemText(StatusWindow^.hwindow,106,pointer(msg.lparam));
- end;
-
- procedure TTestBedWindow.SerialIONotify(var Msg:Tmessage);
- var i:integer;
- c:char;
- str:array[0..2] of char;
- begin
- if not IOChannelOpen then begin
- ShowWindow(StatusWindow^.hwindow,sw_hide);
- end;
- IOChannelOpen := true;
- if msg.wparam > 0
- then
- for i := 1 to msg.wparam do begin
- { While SerialIoWaiting do begin} {<-Alternative logic} {** APPDIAL.DLL **}
- c:= chr(GetSerialByte); {** APPDIAL.DLL **}
-
- if c in [chr(8),chr(13),' '..'z'] then begin
- ioarea[ioareaindex] := C;
- inc(ioareaindex);
- if ioareaindex > IO_AREA_SIZE then begin
- NumLines := 1;
- ioareaindex := 0;
- end;
-
- case ord(c) of
- {Special screen clean-up for CR's and Backspaces...}
- 8:begin {BackSpace}
- dec(ioareaindex,1);
- if ioareaindex < 0 then ioareaindex := 0;
- ioarea[ioareaindex-1] := CURSOR_CHAR;
- ioarea[ioareaindex] := ' ';
- ioarea[ioareaindex+1] := chr(0);
- SendMessage(hwindow,wm_paint,0,0);
- dec(ioareaindex,1);
- end;
- 13:begin {CR}
- ioarea[ioareaindex-1] := ' ';
- ioarea[ioareaindex] := c;
- ioarea[ioareaindex+1] := chr(0);
- Inc(NumLines);
- MyScroller^.SetRange(1,NumLines);
- if numlines > (LinesperScreen-3) then
- MyScroller^.ScrollTo(0,NumLines-LinesperScreen+3);
- SendMessage(hwindow,wm_paint,0,0);
- inc(ioareaindex);
- end;
- end;
-
-
- ioarea[ioareaindex] := CURSOR_CHAR;
- ioarea[ioareaindex+1] := chr(0);
-
- InvalidateRect(hwindow,nil,false);
-
- end;
-
- end;
- end;
-
- procedure TTestBedWindow.EventNotify(var Msg:Tmessage);
- begin
- {Override this notification so it doesn't occur again...}
- SetupNotification('','',msg.wparam,0); {** APPDIAL.DLL **}
- end;
-
- constructor TTestBedWindow.Init(AParent: PWindowsObject; ATitle: PChar);
- begin
- cmdshow := sw_maximize;
- TWindow.Init(AParent,Atitle);
- Attr.Menu := LoadMenu(HInstance, 'Commands');
- attr.style := attr.style or ws_vscroll;
- MyScroller := New(Pscroller, Init(@Self,8,15,1,1));
- scroller := MyScroller;
- MyScroller^.TrackMode := true{false};
- end;
-
- destructor TTestbedWindow.done;
- begin
- freemem(ioarea,IO_AREA_SIZE);
- TWindow.done;
- end;
-
-
- procedure TTestBedWindow.SetupWindow;
- var pt:tpoint;
- msg:tmessage;
- i:integer;
- begin
- TWindow.SetupWindow;
- StatusWindow := New(PStatusWindow,Init(@Self,'Messages'));
- Application^.MakeWindow(StatusWindow);
-
- Getmem(ioarea,IO_AREA_SIZE);
- ioareaindex := 0;
- NumLines := 0;
-
- IOChannelOpen := false;
- CallInProgress := false;
- HangupRequested := false;
- SetParentWindow(hwindow); {** APPDIAL.DLL **}
- SupplyRegistrationCodes('',''); {** APPDIAL.DLL **}
- end;
-
- procedure TTestBedWindow.GetWindowClass(var AWndClass:TWndClass);
- begin
- TWindow.GetWindowClass(AWndClass);
- AWndClass.hIcon := LoadIcon(HInstance, 'icon1');
- end;
-
- function TTestBedWindow.RunDialog(Title,Label1,Label2,Label3:string;
- NumFields:integer):boolean;
- var i,j:integer;
- s:string;
- begin
- DialogTitle := Title;
- FieldLabels[1] := Label1;
- FieldLabels[2] := Label2;
- FieldLabels[3] := Label3;
- j := numfields;
- repeat
- case NumFields of
- 1 :s := 'OneField';
- 2 :s := 'TwoFields';
- 3 :s := 'ThreeFields';
- 99 :begin
- s := 'AutoResponse';
- j := 2;
- end;
- end;
- addnul(s);
- i := Application^.ExecDialog(New(pMultiFieldDlg, Init(@Self, @s[1],j)))
- until i <> 3;
- if i = 1
- then RunDialog := true
- else RunDialog := false;
- end;
-
- procedure TTestBedApp.InitMainWindow;
- begin
- MainWindow := New(PTTestBedWindow, Init(nil,'Dialup-Client Testbed Program - source included'));
- end;
-
- procedure TTestBedApp.InitInstance;
- begin
- TApplication.InitInstance;
- end;
-
-
- var
- TestBedApp : TTestBedApp;
- begin
-
- TestBedApp.Init('TestBedApp');
- TestBedApp.Run;
- TestBedApp.Done;
- end.
-