home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Zodiac Super OZ
/
MEDIADEPOT.ISO
/
FILES
/
22
/
EZDIA175.ZIP
/
TESTBED.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-02-27
|
30KB
|
951 lines
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.