SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00015 COMMUNICATIONS/INT14 ROUTINES 1 05-28-9313:35ALL SWAG SUPPORT TEAM Routines for AVATAR IMPORT 35 {πSEAN PALMERππ> Would you mind sharing that source w/us? I would like toπ> add AVATAR support to my doors, yet don't have those FSC docs.ππHere are some FSC Docs I got off a FIDO echo...ππThe basic commands are: (AVT/0 FSC-0025)ππ <^L> - clear the current Window and set current attributeπ to default. In the basic session this means:π Clear the screen and set its attribute to 3.ππ <^Y> - Read two Bytes from the modem. Send the first oneπ to the screen as many times as the binary valueπ of the second one. This is the exception whereπ the two Bytes may have their high bit set. Doπ not reset it here!ππ <^V> <^A> <attr> - Set the color attribute to <attr>. The defaultπ attribute remains unchanged. However, all Textπ will be displayed in <attr> Until the next ^V^A,π ^V^B, or ^L.ππ <^V> <^B> - Turn the high bit of current attribute on. Inπ other Words, turn blink on.ππ <^V> <^C> - Move the cursor one line up. Do nothing, if youπ already are at the top line of the currentπ Window.ππ <^V> <^D> - Move the cursor one line down. Do nothing if youπ already are at the bottom line of the currentπ Window.ππ <^V> <^E> - Move the cursor one column to the left. Do nothingπ if you already are at the leftmost column of theπ current Window.ππ <^V> <^F> - Move the cursor one column to the right. Do nothingπ if you already are at the rightmost column of theπ current Window.ππ <^V> <^G> - Clear the rest of the line in the current Windowπ using the current attribute (not to be confusedπ With the default attribute).ππ <^V> <^H> <row> <col> - Move the cursor to the <row> <col>π position Within the current Window.ππNew Commands (brief definitions) (AVT/0+ FSC-0037)ππ <^V><^I> - Turn insert mode ON. It stays on Until any other AVT/0π command except <^Y> and <^V><^Y> is encountered afterπ which it is turned off;ππ <^V><^J><numlines><upper><left><lower><right> - scroll area up;ππ <^V><^K><numlines><upper><left><lower><right> - scroll area down;ππ <^V><^L><attr><lines><columns> - clear area, set attribute;ππ <^V><^M><attr><Char><lines><columns> - initialize area, set attribute;ππ <^V><^N> - delete Character, scroll rest of line left;ππ <^V><^Y><numChars><Char>[...]<count> - Repeat pattern.ππand here is some source I use For AVATAR codes.π}ππUnit Avatar; {these Functions return avatar codes as Strings}πInterfaceππ{AVT/0+ FSC-0025}ππConstπ clearScr : String = ^L;π blink : String = ^V^B;π up : String = ^V^C;π dn : String = ^V^D;π lf : String = ^V^E;π rt : String = ^V^F;π cleol : String = ^V^G;ππFunction rep(c : Char; b : Byte) : String;πFunction attr(a : Byte) : String;πFunction goxy(x, y : Byte) : String;ππ{AVT/0+ FSC-0037}ππConstππinsMode : String = ^V^I;πdelChar : String = ^V^N;ππFunction scrollUp(n, l, t, r, b : Byte) : String;πFunction scrollDn(n, l, t, r, b : Byte) : String;πFunction clear(a, w, h : Byte) : String;πFunction fill(c : Char; a, w, h : Byte) : String;πFunction pattern(s : String; n : Byte) : String;ππImplementationππFunction rep(c : Char; b : Byte) : String;πbeginπ rep := ^Y + c + Char(b);πend;ππFunction attr(a : Byte) : String;πbeginπ attr := ^V^A + Char(a and $7F);πend;ππFunction goxy(x, y : Byte) : String;πbeginπ goxy := ^V^H + Char(y) + Char(x);πend;ππFunction scrollUp(n, l, t, r, b : Byte) : String;πbeginπ scrollUp := ^V^J + Char(n) + Char(t) + Char(l) + Char(b) + Char(r);πend;ππFunction scrollDn(n, l, t, r, b : Byte) : String;πbeginπ scrollDn := ^V^K + Char(n) + Char(t) + Char(l) + Char(b) + Char(r);πend;ππFunction clear(a, w, h : Byte) : String;πbeginπ clear := ^V^L + Char(a) + Char(h) + Char(w);πend;ππFunction fill(c : Char; a, w, h : Byte) : String;πbeginπ fill := ^V^M + c + Char(a) + Char(h) + Char(w);πend;ππFunction pattern(s : String; n : Byte) : String;πbeginπ pattern := ^V^Y + s[0] + s + Char(n);πend;ππend.ππ 2 05-28-9313:35ALL SWAG SUPPORT TEAM Carrier Detect IMPORT 6 {π>Does anyone know how to detect when the modem connects?? Thanks.ππThrough the BIOS:π}ππFunction CarrierDetected(Port : Word) : Boolean;πConstπ DCD = $80;πVarπ Dummy : Byte;πbeginπ Asmπ dec portπ mov ah,03hπ mov dx,portπ int 14hπ mov dummy,alπ end;π CarrierDetected := (Dummy and DCD) = DCD { carrier detected }πend;ππ{ Or directly: }ππFunction CarrierDetected(Port : Byte) : Boolean;πbeginπ Case Port ofπ 1: CarrierDetected := ($3FE and $80) = $80; { com 1 cd }π 2: CarrierDetected := ($2FE and $80) = $80 { com 2 cd }π endπend;π 3 05-28-9313:35ALL SWAG SUPPORT TEAM Chat IMPORT 43 {π> Otherwise, how could I tell the difference between the local users inputπ> and the remote users input??? If I knew that I guess I could Write myπ> own chat Procedure.ππWell, I definately agree With you there.. Here's some ugly codeπI put into my doors, it's a chat Procedure, not With all the features I'd like,πbut it works, anyway.. (BTW, I'm working on a split screen version now, butπthat'll take some time as I'm very busy these days..) This is a dump from partπof my SYSKEY.INC include File..π}ππ{$F+}ππ(* This include File is where you will take actions you define when trappedπ keys such as ALT-keys, Function-keys, etc., are pressed.ππ You will need to setup your Procedures here which in turn may call otherπ Procedures within your code or you may do all you need to do right here.ππ For example, if you wanted to trap For ALT-C being pressed on the localπ keyboard and then call the Procedure CHAT:ππ Your main block of code might look like this:ππ begin {main}π ASSIGN(Output,'') ;π REWrite(Output) ;π SysopKey[1] := #0 + #46 ; {define ALT-C as one of twenty keys }π {to trap }π SysopProc[1] := ALT_C ; {define Procedure as defined here }π SysopKey ; {setup For Far call to this File }π end ;ππ Now, whenever ALT-C is pressed, the following Procedure will be called:ππ Procedure ALT_C ;π beginπ CHAT ; {call Procedure CHAT which is located }π end ; {within your Program's code }ππ *)ππ(*π The following Procedures are called when up/down arrows are pressedπ provided they are defined using SysopKey[] and SysopProc[] withinπ the main Program codeπ*)ππProcedure end_Chat;ππbeginπ Chatended := True;π { Do some other stuff here if you'd like }πend;ππProcedure Chat;ππConstπ FKeyCode = #0;π Space = ' ';π Hyphen = '-';π BackSpace = ^H;π CarriageReturn = ^M;π MaxWordLineLength = 80;ππVarπ WordLine : String[MaxWordLineLength];π Index1 : Byte;π Index2 : Byte;π InputChar : Char;π F : Text;ππLabel Get_Char;ππbegin {WordWrap}π If LocalKey Thenπ SetColor(0,14,0)π Elseπ SetColor(0,3,0);π UserKeysOn := False;π WordLine := '';π Index1 := 0;π Index2 := 0;π InputChar := Space;π ClearScreen;π Display(0,3,0,'');π Display(0,12,0,'Sysop Entering Chat Mode: ');π InputChar := GetChar;π If LocalKey Thenπ SetColor(0,14,0)π Elseπ SetColor(0,3,0);π InactiveVal := 0;ππ While (NOT Chatended)π do beginπ If LocalKey Thenπ SetColor(0,14,0)π Elseπ SetColor(0,3,0);π Case InputChar OFπ BackSpace: {Write destructive backspace & remove Char from WordLine}π beginπ If LocalKey Thenπ SetColor(0,14,0)π Elseπ SetColor(0,3,0);π sDisplay(0,7,0,BackSpace+Space+BackSpace);π DELETE(WordLine,(LENGTH(WordLine) - 1),1)π endπ else {InputChar contains a valid Char, so deal With it}π beginπ If ( InPutChar = Chr(13) ) Thenπ beginπ If LocalKey Thenπ Display(0,14,0,InputChar)π Elseπ Display(0,3,0,InputChar);π endπ Elseπ beginπ If LocalKey Thenπ sDisplay(0,14,0,InputChar)π Elseπ sDisplay(0,3,0,InputChar);π end;π If InputChar <> Chr(13) Thenπ WordLine := (WordLine + InputChar)π Elseπ WordLine := '';π if (LENGTH(WordLine) >= (MaxWordLineLength - 1)) then {we have to do a Word-wrap}π beginπ Index1 := (MaxWordLineLength - 1);π While ((WordLine[Index1] <> Space) and (WordLine[Index1] <> Hyphen) and (Index1 <> 0)) DOπ Index1 := (Index1 - 1);π if (Index1 = 0) {whoah, no space was found to split line!} thenπ Index1 := (MaxWordLineLength - 1); {forces split}π DELETE(WordLine, 1, Index1);π For Index2 := 1 to LENGTH(WordLine) DOπ sDisplay(0, 7, 0, BackSpace + Space + BackSpace);π Display(0,3,0,'');π If InPutChar = Chr(13) thenπ beginπ If LocalKey Thenπ Display(0,14,0,WordLine)π Elseπ Display(0,3,0,WordLine);π endπ Elseπ beginπ If LocalKey Thenπ sDisplay(0,14,0,WordLine)π Elseπ sDisplay(0,3,0,WordLine);π end;π endπ endπ end; {CASE InputChar}π {Get next key from user.}π Get_Char:π beginπ InputChar := GetChar;π If ( WordLine = '' ) and ( InputChar = Chr(13) ) Thenπ beginπ Display(0,3,0,'');π Goto Get_Char;π end;π end;π end; {WHILE ( not (Chatended) )}π Display(0, 12, 0, 'Sysop Left Chat Mode.');π If (NOT Registered) Thenπ DisplayLoc(0, 7, 0, '■ If you find this Program of value, please register.');π Delay(2500);π Display(0, 15, 0, 'Press ( '+#17+'──┘ ) to Continue . . .');π ClearScreen;π Chatended := False;π InactiveVal := 30;π UserKeysOn := True;πend;π{πThere.. let me know if you need any clarification.. (BTW, you need globalπVariables Chatended and Registered as Booleans in the main program..π} 4 05-28-9313:35ALL SWAG SUPPORT TEAM Communications Port IMPORT 13 { >1. Let me look at the RING line from the modemπ >2. Let me determine the condition of CARRIER DETECT.ππ The Modem Status Register (MSR) Byte contains this info.ππ Carrier Detect: MSR bit 7 will be set it there is a carrierπ detected. Bit 3 indicates if there has been a change in theπ carrier detect status since the last time the MSR was read.ππ Ring: is indicated by MSR bit 6. Bit 2 indicates if thereπ was a change in bit 6 since the last time the MST was read.ππ Bits 2 and 3 are cleared each time the MSR is read.ππ Obtaining the MSR Byte may be done by directly reading theπ port value, or by calling the BIOS modem services interrupt $14.ππ I've Typed in the following without testing.ππ Using the BIOS...ππ ...π}πFunction GetMSR( COMport :Byte ) :Byte;π{ call With COMport 1 or 2 }πVarπ Reg : Registers;πbeginπ Reg.DX := COMport - 1;π Reg.AH := 3;π Intr( $14, Reg );π GetMSR := Reg.ALπend;π(*π...πMSRByte := GetMSR(1); { MSR For COM1 (clears bits 0..3) }π...ππ Using direct access: For COM1, the MSR is at port $3FE; For COM2π it's at $2FE...ππ ...π MSRByte := Port[$3FE]; { MSR For COM1 (clears bits 0..3) }π ...ππ To test the status...ππ ...π*)πIF ( MSRByte and $80 ) <> 0 thenπ CarrierDetect := TrueπELSEπ CarrierDetect := False;πIF ( MSRByte and $40 ) <> 0 thenπ Ring := True;πELSEπ Ring := False;π{ππ Similar logic can be used With bits 2 and 3, which will informπ you of whether or not a change occurred in bit 6 or 7 since theπ last read of the MSR.π} 5 05-28-9313:35ALL SWAG SUPPORT TEAM Another Carrier Detect IMPORT 4 {πAuthor: Sean Palmerππ> Does anyone know how to detect when the modem connects?? Thanks.ππCheck For a carrier: (periodically, like 2-4 times per second)π}ππConstπ pBase = $3F8; {change For which port you're using}π pMSR = pBase + 6; {modem status register}ππFunction carrier : Boolean;πbeginπ carrier := (port[pMSR] and $80) <> 0;πend;ππ 6 05-28-9313:35ALL SWAG SUPPORT TEAM Remote ANSI Detect IMPORT 13 { determine if ANSI.SYS loaded on micro }πFunction AnsiSysLoaded : Boolean;πVarπ _AX : Word;π Regs: Registers;πbeginπ Regs.AX := $1a00;π Intr($2f,Regs);π _Ax := Regs.AX;π ANSISysLoaded := Lo(_AX) = $FFπend;ππ{ ------------------------------------------------------------------------π DETECTANSIπ Detect whether the remote user has ANSI support For initial Graphic mode.π ------------------------------------------------------------------------ }πFunction DetectAnsi : Boolean;πVarπ AnsiDetected : Boolean;π AnsiChar : Char;πbeginπ AnsiDetected := False;π If (OrgCarr) then { not sysop_local then }π beginπ Fossil.ModemPut(#27+'[6n'); { Esc[6n (Cursor Position Request) }π Fossil.FlushBuff;π Crt.Delay(2000); { waits For response (2 second) }π If (Fossil.SerialChar) then { if modem buffer is not empty }π beginπ AnsiChar := Fossil.Receive;π If (AnsiChar in [#27,'0'..'9','[','H']) thenπ AnsiDetected := True;π end;π Crt.Delay(1000); { Pause 1 second }π Fossil.PurgeLine; { Purge input buffer }π Fossil.PurgeOutput; { Make sure nothing is in output buffer }π endπ elseπ { if local, check For ANSI.SYS loaded }π AnsiDetected := AnsiSysLoaded;π { here you might wanna say:π if not AnsiSysLoaded then UseAnsiSimulator := True; }ππ If AnsiDetected thenπ PrintLn('ANSI Graphics detected.')π elseπ PrintLn('ANSI Graphics disabled.');π DetectAnsi := AnsiDetected;πend;π 7 05-28-9313:35ALL SWAG SUPPORT TEAM Dialing IMPORT 29 {π GL> I am writing a simple dialer and would like to know how doπ GL> I recieve the mode String like "BUSY" and "NO CARRIER" , Iπ GL> tried opening the Comport For reading but i just hung theπ GL> Computer. Could you please tell me how ?π GL> Regards , Garethππ Gareth,π I didn't see any replies to your message, but I've been lookingπ For the same inFormation myself. I saw the following code, basedπ on a message from Norbert Igl, last year. When I dial my ownπ phone number, it gives me a busy signal For a second or two, andπ then hangs up. I don't know what makes the busy signal stop. andπ I don't know how to receive the modem String "BUSY" or "NO CARRIER"π or "NO DIALtoNE".ππ I noticed in my modem manual that modem command X4 willπ generate the following responses:ππ Number Response Word Responseπ (V0 command) (V1 command)ππ 6 NO DIALtoNEπ 7 BUSYπ 8 NO ANSWERπ (The modem responds With 8 if you sendπ the @ command [Wait For Quiet Answer],π and it didn't subsequently detect 5π seconds of silence.)ππ I wish I could figure out a way to "capture" the response, either theπ number (say, 7) or the Word ('BUSY'). if I could detect a busyπ signal, I could then create a loop that would make theπ Program continually redial if it detected busy signals.ππ if you figure it out, could you post your solution?ππ Here's how Norbert's code With a few modifications:ππ Date: 29 Jun 92 23:15:00π From: Norbert Iglπ to: Jud Mccranieπ Subj: Dialing the phoneππ here's a COM3-able version...(:-)}ππ Program Dialing;π Uses Crt;π (* no error checking... *)ππ Var ch : Char;π num : String;ππ Function Dial( Nb:String; ComPort:Byte ):Char;π Const DialCmd = 'ATDT';π OnHook = 'ATH';π CR = #13;π Status = 5;π Var UserKey : Char;π PortAdr : Word;ππ Procedure Com_Write( S: String );π Var i:Byte;ππ Function OutputOk:Boolean;π beginπ OutPutOk := ( Port[PortAdr+Status] and $20) > 0;π end;ππ Procedure ComWriteCh( Var CH:Char);π beginπ Repeat Until OutPutOk;π Port[PortAdr] := Byte(CH);π end;ππ beginπ For i := 1 to length(s) do ComWriteCh(S[i]);π end;ππ Procedure Com_Writeln( S : String );π beginπ Com_Write( S + CR )π end;ππ { DIAL.Main }π beginπ if (ComPort < 1) or ( ComPort > 4) then Exit;π PortAdr := MemW[$40:(ComPort-1)*2 ];π if PortAdr = 0 then Exit;π Repeatπ Com_Writeln( OnHook );π Delay( 500 );π Com_Write ( DialCmd );π Com_Writeln( Nb );π UserKey := ReadKey;π Until UserKey <> ' '; { Hit [SPACE] to redial ! }π Com_Writeln( OnHook ); { switch the line to the handset ...}π Dial := UserKey; { see what key the user pressed... }π end;ππ beginπ ClrScr;π Write ('Enter your own phone number: ');π Readln(Num);π Writeln('Dialing now... Should get a busy signal.');π ch := dial(Num,2);π end.π 8 05-28-9313:35ALL SWAG SUPPORT TEAM EMSI IMPORT 52 {πTERRY GRANTππHere is a Unit I posted some time ago For use With EMSI Sessions. Hope itπhelps some of you out. You will require a fossil or Async Interface forπthis to compile!π}ππProgram Emsi;ππUsesπ Dos , Crt, Fossil;ππTypeπ HexString = String[4];ππConstπ FingerPrint = '{EMSI}';π System_Address = '1:210/20.0'; { Your address }π PassWord = 'PASSWord'; { Session passWord }π Link_Codes = '{8N1}'; { Modem setup }π Compatibility_Codes = '{JAN}'; { Janis }π Mailer_Product_Code = '{00}';π Mailer_Name = 'MagicMail';π Mailer_Version = '1.00';π Mailer_Serial_Number = '{Alpha}';π EMSI_INQ : String = '**EMSI_INQC816';π EMSI_REQ : String = '**EMSI_REQA77E';π EMSI_ACK : String = '**EMSI_ACKA490';π EMSI_NAK : String = '**EMSI_NAKEEC3';π EMSI_CLI : String = '**EMSI_CLIFA8C';π EMSI_ICI : String = '**EMSI_ICI2D73';π EMSI_HBT : String = '**EMSI_HBTEAEE';π EMSI_IRQ : String = '**EMSI_IRQ8E08';ππVarπ EMSI_DAT : String; { NOTE : EMSI_DAT has no maximum length }π Length_EMSI_DAT : HexString; { Expressed in Hexidecimal }π Packet : String;π Rec_EMSI_DAT : String; { EMSI_DAT sent by the answering system }π Len_Rec_EMSI_DAT : Word;ππ Len,π CRC : HexString;ππ R : Registers;π C : Char;π Loop,ComPort,TimeOut,Tries : Byte;π Temp : String;ππFunction Up_Case(St : String) : String;πbeginπ For Loop := 1 to Length(St) doπ St[Loop] := Upcase(St[Loop]);ππ Up_Case := St;πend;ππFunction Hex(i : Word) : HexString;πConstπ hc : Array[0..15] of Char = '0123456789ABCDEF';πVarπ l, h : Byte;πbeginπ l := Lo(i);π h := Hi(i);π Hex[0] := #4; { Length of String = 4 }π Hex[1] := hc[h shr 4];π Hex[2] := hc[h and $F];π Hex[3] := hc[l shr 4];π Hex[4] := hc[l and $F];πend {Hex} ;ππFunction Power(Base,E : Byte) : LongInt;πbeginπ Power := Round(Exp(E * Ln(Base) ));πend;ππFunction Hex2Dec(HexStr : String) : LongInt;ππVarπ I,HexBit : Byte;π Temp : LongInt;π Code : Integer;ππbeginπ Temp := 0;π For I := Length(HexStr) downto 1 doπ beginπ If HexStr[I] in ['A','a','B','b','C','c','D','d','E','e','F','f'] thenπ Val('$' + HexStr[I],HexBit,Code)π elseπ Val(HexStr[I],HexBit,Code);π Temp := Temp + HexBit * Power(16,Length(HexStr) - I);π end;π Hex2Dec := Temp;πend;ππFunction Bin2Dec(BinStr : String) : LongInt;ππ{ Maximum is 16 bits, though a requirement For more would be }π{ easy to accomodate. Leading zeroes are not required. There }π{ is no error handling - any non-'1's are taken as being zero. }ππVarπ I : Byte;π Temp : LongInt;π BinArray : Array[0..15] of Char;ππbeginπ For I := 0 to 15 doπ BinArray[I] := '0';π For I := 0 to Pred(Length(BinStr)) doπ BinArray[I] := BinStr[Length(BinStr) - I];π Temp := 0;π For I := 0 to 15 doπ If BinArray[I] = '1' thenπ inc(Temp,Round(Exp(I * Ln(2))));π Bin2Dec := Temp;πend;ππFunction CRC16(s:String):Word; { By Kevin Cooney }πVarπ crc : LongInt;π t,r : Byte;πbeginπ crc:=0;π For t:=1 to length(s) doπ beginπ crc:=(crc xor (ord(s[t]) shl 8));π For r:=1 to 8 doπ if (crc and $8000)>0 thenπ crc:=((crc shl 1) xor $1021)π elseπ crc:=(crc shl 1);π end;π CRC16:=(crc and $FFFF);πend;ππ{**** FOSSIL Routines ****}π{**** Removed from Code ***}ππProcedure Hangup;πbeginπ Write2Port('+++'+#13);πend;ππ{**** EMSI Handshake Routines ****}ππProcedure Create_EMSI_DAT;πbeginπ FillChar(EMSI_DAT,255,' ');ππ EMSI_DAT := FingerPrint + '{' + System_Address + '}{'+ PassWord + '}' +π Link_Codes + Compatibility_Codes + Mailer_Product_Code +π '{' + Mailer_Name + '}{' + Mailer_Version + '}' +π Mailer_Serial_Number;ππ Length_EMSI_DAT := Hex(Length(EMSI_DAT));πend;ππFunction Carrier_Detected : Boolean;πbeginπ TimeOut := 20; { Wait approximately 20 seconds }π Repeatπ Delay(1000);π Dec(TimeOut);π Until (TimeOut = 0) or (Lo(StatusReq) and $80 = $80);ππ If Timeout = 0 thenπ Carrier_Detected := Falseπ elseπ Carrier_Detected := True;πend;ππFunction Get_EMSI_REQ : Boolean;πbeginπ Temp := '';π Purge_Input;ππ Repeatπ C := ReadKeyfromPort;π If (C <> #10) and (C <> #13) thenπ Temp := Temp + C;π Until Length(Temp) = Length(EMSI_REQ);ππ If Up_Case(Temp) = EMSI_REQ thenπ get_EMSI_REQ := Trueπ elseπ get_EMSI_REQ := False;πend;ππProcedure Send_EMSI_DAT;πbeginπ CRC := Hex(CRC16('EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT));π Write2Port('**EMSI_DAT' + Length_EMSI_DAT + EMSI_DAT + CRC);πend;ππFunction Get_EMSI_ACK : Boolean;πbeginπ Temp := '';ππ Repeatπ C := ReadKeyfromPort;π If (C <> #10) and (C <> #13) thenπ Temp := Temp + C;π Until Length(Temp) = Length(EMSI_ACK);ππ If Up_Case(Temp) = EMSI_ACK thenπ get_EMSI_ACK := Trueπ elseπ get_EMSI_ACK := False;πend;ππProcedure Get_EMSI_DAT;πbeginπ Temp := '';π For Loop := 1 to 10 do { Read in '**EMSI_DAT' }π Temp := Temp + ReadKeyfromPort;ππ Delete(Temp,1,2); { Remove the '**' }ππ Len := '';π For Loop := 1 to 4 do { Read in the length }π Len := Len + ReadKeyFromPort;ππ Temp := Temp + Len;ππ Len_Rec_EMSI_DAT := Hex2Dec(Len);ππ Packet := '';π For Loop := 1 to Len_Rec_EMSI_DAT do { Read in the packet }π Packet := Packet + ReadKeyfromPort;ππ Temp := Temp + Packet;ππ CRC := '';π For Loop := 1 to 4 do { Read in the CRC }π CRC := CRC + ReadKeyFromPort;ππ Rec_EMSI_DAT := Packet;ππ Writeln('Rec_EMSI_DAT = ',Rec_EMSI_DAT);ππ If Hex(CRC16(Temp)) <> CRC thenπ Writeln('The recieved EMSI_DAT is corrupt!!!!');πend;ππbeginπ { Assumes connection has been made at this point }ππ Tries := 0;π Repeatπ Write2Port(EMSI_INQ);π Delay(1000);π Inc(Tries);π Until (Get_EMSI_REQ = True) or (Tries = 5);ππ If Tries = 5 thenπ beginπ Writeln('Host system failed to acknowledge the inquiry sequence.');π Hangup;π Halt;π end;ππ { Used For debugging }π Writeln('Boss has acknowledged receipt of EMSI_INQ');ππ Send_EMSI_DAT;ππ Tries := 0;π Repeatπ Inc(Tries);π Until (Get_EMSI_ACK = True) or (Tries = 5);ππ If Tries = 5 thenπ beginπ Writeln('Host system failed to acknowledge the EMSI_DAT packet.');π Hangup;π halt;π end;ππ Writeln('Boss has acknowledged receipt of EMSI_DAT');ππ Get_EMSI_DAT;π Write2Port(EMSI_ACK);ππ { Normally the File transfers would start at this point }π Hangup;πend.ππ{π This DOES not include all the possibilities in an EMSI Session.π} 9 05-28-9313:35ALL SWAG SUPPORT TEAM ASYNC Routines IMPORT 221 {π>doors. But, i have one little problem: I don't know how to hang-up the modemπ>- I am using a ready-made TPU that does all the port tasks, but it just can'π>hang up!ππHere is some code I pulled out of this conference a While ago:π}ππUnit EtAsync;ππ{****************************************************************************}π{* EtAsync V.1.04, 9/4 1992 Et-Soft *}π{* *}π{* Turbo Pascal Unit With support For up to 8 serial ports. *}π{****************************************************************************}ππ{$A-} {- Word alignment -}π{$B-} {- Complete Boolean evaluation -}π{$D-} {- Debug inFormation -}π{$E-} {- Coprocessor emulation -}π{$F+} {- Force Far calls -}π{$I-} {- I/O checking -}π{$L-} {- Local debug symbols -}π{$N-} {- Coprocessor code generation -}π{$O-} {- Overlayes allowed -}π{$R-} {- Range checking -}π{$S-} {- Stack checking -}π{$V-} {- Var-String checking -}π{$M 16384,0,655360} {- Stack size, min heap, max heap -}π{****************************************************************************}π Interfaceπ{****************************************************************************}πUsesπ Dos;π{****************************************************************************}π {- Standard baudrates: -}π {- 50, 75, 110, 134 (134.5), 150, 300, 600, 1200, 1800, 2000, 2400, 3600, -}π {- 4800, 7200, 9600, 19200, 38400, 57600, 115200 -}ππFunction OpenCOM {- Open a COMport For communication -}π (Nr : Byte; {- Internal portnumber: 0-7 -}π Address : Word; {- Port address in hex: 000-3F8 -}π IrqNum : Byte; {- Port Irq number: 0-7 (255 For no Irq) -}π Baudrate : LongInt; {- Baudrate: (see table) -}π ParityBit : Char; {- Parity : 'O','E' or 'N' -}π Databits : Byte; {- Databits: 5-8 -}π Stopbits : Byte; {- Stopbits: 1-2 -}π BufferSize : Word; {- Size of input buffer: 0-65535 -}π Handshake : Boolean) {- True to use hardware handshake -}π : Boolean; {- Returns True if ok -}ππProcedure CloseCOM {- Close a open COMport -}π (Nr : Byte); {- Internal portnumber: 0-7 -}ππProcedure ResetCOM {- Reset a open COMport incl. buffer -}π (Nr : Byte); {- Internal portnumber: 0-7 -}ππProcedure COMSettings {- Change settings For a open COMport -}π (Nr : Byte; {- Internal portnumber: 0-7 -}π Baudrate : LongInt; {- Baudrate: (see table) -}π Paritybit : Char; {- Parity : 'O','E' or 'N' -}π Databits : Byte; {- Databits: 5-8 -}π Stopbits : Byte; {- Stopbits: 1-2 -}π Handshake : Boolean); {- True to use hardware handshake -}ππFunction COMAddress {- Return the address For a COMport (BIOS) -}π (COMport : Byte) {- COMport: 1-8 -}π : Word; {- Address found For COMport (0 if none) -}ππFunction WriteCOM {- Writes a Character to a port -}π (Nr : Byte; {- Internal portnumber: 0-7 -}π Ch : Char) {- Character to be written to port -}π : Boolean; {- True if Character send -}ππFunction WriteCOMString {- Writes a String to a port -}π (Nr : Byte; {- Internal portnumber: 0-7 -}π St : String) {- String to be written to port -}π : Boolean; {- True if String send -}ππFunction CheckCOM {- Check if any Character is arrived -}π (Nr : Byte; {- Internal portnumber: 0-7 -}π Var Ch : Char) {- Character arrived -}π : Boolean; {- Returns True and Character if any -}ππFunction COMError {- Returns status of the last operation -}π : Integer; {- 0 = Ok -}π {- 1 = not enough memory -}π {- 2 = Port not open -}π {- 3 = Port already used once -}π {- 4 = Selected Irq already used once -}π {- 5 = Invalid port -}π {- 6 = Timeout -}π {- 7 = Port failed loopback test -}π {- 8 = Port failed IRQ test -}ππFunction TestCOM {- PerForms a loopback and IRQ test on a port -}π (Nr : Byte) {- Internal port number: 0-7 -}π : Boolean; {- True if port test ok -}π {- note: This is perFormed during OpenCOM -}π {- if enabled (TestCOM is by default enabled -}π {- during OpenCOM, but can be disabled With -}π {- the DisableTestCOM routine) -}ππProcedure EnableTestCOM; {- Enable TestCOM during Openport (Default On) }ππProcedure DisableTestCOM; {- Disable TestCOM during Openport -}ππFunction COMUsed {- Check whether or not a port is open -}π (Nr : Byte) {- Internal port number: 0-7 -}π : Boolean; {- True if port is open and in use -}π {- note: This routine can not test -}π {- whether or not a COMport is used byπ {- another application -}ππFunction IrqUsed {- Check whether or not an Irq is used -}π (IrqNum : Byte) {- Irq number: 0-7 -}π : Boolean; {- True if Irq is used -}π {- note: This routine can not test -}π {- whether or not an IRQ is used by -}π {- another application -}ππFunction IrqInUse {- Test IRQ in use on the PIC -}π (IrqNum : Byte) {- Irq number: 0-7 -}π : Boolean; {- True if Irq is used -}ππProcedure SetIrqPriority {- Set the Irq priority level on the PIC -}π (IrqNum : Byte); {- Irq number: 0-7 -}π {- The IrqNum specified will get the highest -}π {- priority, the following Irq number willπ {- then have the next highest priority -}π {- and so on -}ππProcedure ClearBuffer {- Clear the input buffer For a open port -}π (Nr : Byte); {- Internal port number: 0-7 -}πππ{****************************************************************************}π Implementationπ{****************************************************************************}πTypeπ Buffer = Array[1..65535] of Byte; {- Dummy Type For Interrupt buffer -}π PortRec = Record {- Portdata Type -}π InUse : Boolean; {- True if port is used -}π Addr : Word; {- Selected address -}π Irq : Byte; {- Selected Irq number -}π OldIrq : Byte; {- Status of Irq beFore InitCOM -}π HShake : Boolean; {- Hardware handshake on/off -}π Buf : ^Buffer; {- Pointer to allocated buffer -}π BufSize : Word; {- Size of allocated buffer -}π OldVec : Pointer; {- Saved old interrupt vector -}π Baud : LongInt; {- Selected baudrate -}π Parity : Char; {- Selected parity -}π Databit : Byte; {- Selected number of databits -}π Stopbit : Byte; {- Selected number of stopbits -}π InPtr : Word; {- Pointer to buffer input index -}π OutPtr : Word; {- Pointer to buffer output index -}π Reg0 : Byte; {- Saved UART register 0 -}π Reg1 : Array[1..2] of Byte; {- Saved UART register 1's -}π Reg2 : Byte; {- Saved UART register 2 -}π Reg3 : Byte; {- Saved UART register 3 -}π Reg4 : Byte; {- Saved UART register 4 -}π Reg6 : Byte; {- Saved UART register 6 -}π end;ππVarπ COMResult : Integer; {- Last Error (Call COMError) -}π ExitChainP : Pointer; {- Saved Exitproc Pointer -}π OldPort21 : Byte; {- Saved PIC status -}π Ports : Array[0..7] of PortRec; {- The 8 ports supported -}ππConstπ PIC = $20; {- PIC control address -}π EOI = $20; {- PIC control Byte -}π TestCOMEnabled : Boolean = True; {- Test port during OpenCOM -}ππ{****************************************************************************}πProcedure DisableInterrupts; {- Disable interrupt -}πbeginπ Inline($FA); {- CLI (Clear Interruptflag) -}πend;π{****************************************************************************}πProcedure EnableInterrupts; {- Enable interrupts -}πbeginπ Inline($FB); {- STI (Set interrupt flag) -}πend;π{****************************************************************************}πProcedure Port0Int; Interrupt; {- Interrupt rutine port 0 -}πbeginπ With Ports[0] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port1Int; Interrupt; {- Interrupt rutine port 1 -}πbeginπ With Ports[1] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port2Int; Interrupt; {- Interrupt rutine port 2 -}πbeginπ With Ports[2] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port3Int; Interrupt; {- Interrupt rutine port 3 -}πbeginπ With Ports[3] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port4Int; Interrupt; {- Interrupt rutine port 4 -}πbeginπ With Ports[4] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port5Int; Interrupt; {- Interrupt rutine port 5 -}πbeginπ With Ports[5] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port6Int; Interrupt; {- Interrupt rutine port 6 -}πbeginπ With Ports[6] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port -}π Inc(InPtr); {- Count one step Forward.. }π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer -}π end;π Port[PIC] := EOI; {- Send EOI to PIC -}πend;π{****************************************************************************}πProcedure Port7Int; Interrupt; {- Interrupt rutine port 7 -}πbeginπ With Ports[7] Doπ beginπ Buf^[InPtr] := Port[Addr]; {- Read data from port-}π Inc(InPtr); {- Count one step Forward..}π if InPtr > BufSize thenπ InPtr := 1; { .. in buffer-}π end;π Port[PIC] := EOI; {- Send EOI to PIC-}πend;π{****************************************************************************}πProcedure InitPort(Nr : Byte; SaveStatus : Boolean); {- Port initialize -}ππVarπ divider : Word; {- Baudrate divider number -}π CtrlBits : Byte; {- UART control Byte -}ππbeginπ With Ports[Nr] Doπ beginπ divider := 115200 div Baud; {- Calc baudrate divider -}ππ CtrlBits := DataBit - 5; {- Insert databits -}ππ if Parity <> 'N' thenπ beginπ CtrlBits := CtrlBits or $08; {- Insert parity enable -}π if Parity = 'E' then {- Enable even parity -}π CtrlBits := CtrlBits or $10;π end;ππ if Stopbit = 2 thenπ CtrlBits := CtrlBits or $04; {- Insert stopbits -}ππ if SaveStatus thenπ Reg3 := Port[Addr + $03]; {- Save register 3 -}π Port[Addr + $03] := $80; {- Baudrate change -}ππ if SaveStatus thenπ Reg0 := Port[Addr + $00]; {- Save Lo Baud -}π Port[Addr + $00] := Lo(divider); {- Set Lo Baud -}ππ if SaveStatus thenπ Reg1[2] := Port[Addr + $01]; {- Save Hi Baud -}π Port[Addr + $01] := Hi(divider); {- Set Hi Baud -}ππ Port[Addr + $03] := CtrlBits; {- Set control reg. -}π if SaveStatus thenπ Reg6 := Port[Addr + $06]; {- Save register 6 -}π end;πend;π{****************************************************************************}πFunction IrqUsed(IrqNum : Byte) : Boolean;ππVarπ Count : Byte;π Found : Boolean;ππbeginπ Found := False; {- Irq not found -}π Count := 0; {- Start With port 0 -}ππ While (Count <= 7) and not Found Do {- Count the 8 ports -}π With Ports[Count] Doπ beginπ if InUse thenπ Found := IrqNum = Irq; {- Check Irq match -}π Inc(Count); {- Next port -}π end;ππ IrqUsed := Found; {- Return Irq found -}πend;π{****************************************************************************}πProcedure EnableTestCOM;πbeginπ TestCOMEnabled := True;πend;π{****************************************************************************}πProcedure DisableTestCOM;πbeginπ TestCOMEnabled := False;πend;π{****************************************************************************}πFunction TestCOM(Nr : Byte) : Boolean;ππVarπ OldReg0 : Byte;π OldReg1 : Byte;π OldReg4 : Byte;π OldReg5 : Byte;π OldReg6 : Byte;π OldInPtr : Word;π OldOutPtr : Word;π TimeOut : Integer;ππ beginππ TestCOM := False;ππ With Ports[Nr] Doπ beginπ if InUse thenπ beginπ OldInPtr := InPtr;π OldOutPtr := OutPtr;π OldReg1 := Port[Addr + $01];π OldReg4 := Port[Addr + $04];π OldReg5 := Port[Addr + $05];π OldReg6 := Port[Addr + $06];ππ Port[Addr + $05] := $00;π Port[Addr + $04] := Port[Addr + $04] or $10;ππ OldReg0 := Port[Addr + $00];π OutPtr := InPtr;ππ TimeOut := MaxInt;π Port[Addr + $00] := OldReg0;ππ While (Port[Addr + $05] and $01 = $00) and (TimeOut <> 0) Doπ Dec(TimeOut);ππ if TimeOut <> 0 thenπ beginπ if Port[Addr + $00] = OldReg0 thenπ beginπ if IRQ In [0..7] thenπ beginπ TimeOut := MaxInt;π OutPtr := InPtr;ππ Port[Addr + $01] := $08;π Port[Addr + $04] := $08;π Port[Addr + $06] := Port[Addr + $06] or $01;ππ While (InPtr = OutPtr) and (TimeOut <> 0) Doπ Dec(TimeOut);ππ Port[Addr + $01] := OldReg1;ππ if (InPtr <> OutPtr) thenπ TestCOM := Trueπ elseπ COMResult := 8;π endπ elseπ TestCOM := True;π endπ elseπ COMResult := 7; {- Loopback test failed -}π endπ elseπ COMResult := 6; {- Timeout -}ππ Port[Addr + $04] := OldReg4;π Port[Addr + $05] := OldReg5;π Port[Addr + $06] := OldReg6;ππ For TimeOut := 1 to MaxInt Do;π if Port[Addr + $00] = 0 then;ππ InPtr := OldInPtr;π OutPtr := OldOutPtr;π endπ elseπ COMResult := 2; {- Port not open -}π end;πend;π{****************************************************************************}πProcedure CloseCOM(Nr : Byte);ππbeginπ With Ports[Nr] Doπ beginπ if InUse thenπ beginπ InUse := False;ππ if Irq <> 255 then {- if Interrupt used -}π beginπ FreeMem(Buf,BufSize); {- Deallocate buffer -}π DisableInterrupts;π Port[$21] := Port[$21] or ($01 Shl Irq) and OldIrq;π{-restore-}π Port[Addr + $04] := Reg4; {- Disable UART OUT2 -}π Port[Addr + $01] := Reg1[1]; {- Disable UART Int. -}π SetIntVec($08+Irq,OldVec); {- Restore Int.Vector -}π EnableInterrupts;π end;ππ Port[Addr + $03] := $80; {- UART Baud set -}π Port[Addr + $00] := Reg0; {- Reset Lo Baud -}π Port[Addr + $01] := Reg1[2]; {- Reset Hi Baud -}π Port[Addr + $03] := Reg3; {- Restore UART ctrl. -}π Port[Addr + $06] := Reg6; {- Restore UART reg6 -}π endπ elseπ COMResult := 2; {- Port not in use -}π end;πend;π{****************************************************************************}πFunction OpenCOMπ (Nr : Byte; Address : Word; IrqNum : Byte; Baudrate : LongInt;π ParityBit : Char; Databits, Stopbits : Byte; BufferSize : Word;π HandShake : Boolean) : Boolean;ππVarπ IntVec : Pointer;π OldErr : Integer;ππbeginπ OpenCOM := False;ππ if (IrqNum = 255) orπ ((IrqNum In [0..7]) and (MaxAvail >= LongInt(BufferSize))π and not IrqUsed(IrqNum)) thenπ With Ports[Nr] Doπ beginπ if not InUse and (Address <= $3F8) thenπ beginπ InUse := True; {- Port now in use -}ππ Addr := Address; {- Save parameters -}π Irq := IrqNum;π HShake := HandShake;π BufSize := BufferSize;π Baud := Baudrate;π Parity := Paritybit;π Databit := Databits;π Stopbit := Stopbits;ππ InPtr := 1; {- Reset InputPointer -}π OutPtr := 1; {- Reset OutputPointer -}ππ if (Irq In [0..7]) and (BufSize > 0) thenπ beginπ GetMem(Buf,BufSize); {- Allocate buffer -}π GetIntVec($08+Irq,OldVec); {- Save Interrupt vector -}ππ Case Nr of {- Find the interrupt proc. -}π 0 : IntVec := @Port0Int;π 1 : IntVec := @Port1Int;π 2 : IntVec := @Port2Int;π 3 : IntVec := @Port3Int;π 4 : IntVec := @Port4Int;π 5 : IntVec := @Port5Int;π 6 : IntVec := @Port6Int;π 7 : IntVec := @Port7Int;π end;ππ Reg1[1] := Port[Addr + $01]; {- Save register 1 -}π Reg4 := Port[Addr + $04]; {- Save register 4 -}π OldIrq := Port[$21] or not ($01 Shl Irq);{- Save PIC Irq -}ππ DisableInterrupts; {- Disable interrupts -}π SetIntVec($08+Irq,IntVec); {- Set the interrupt vector -}π Port[Addr + $04] := $08; {- Enable OUT2 on port -}π Port[Addr + $01] := $01; {- Set port data avail.int. -}π Port[$21] := Port[$21] and not ($01 Shl Irq);{- Enable Irq-}π EnableInterrupts; {- Enable interrupts again -}π end;π InitPort(Nr,True); {- Initialize port -}ππ if TestCOMEnabled thenπ beginπ if not TestCOM(Nr) thenπ beginπ OldErr := COMResult;π CloseCOM(Nr);π COMResult := OldErr;π endπ elseπ OpenCOM := True;π endπ elseπ OpenCOM := True;ππ if Port[Addr + $00] = 0 then; {- Remove any pending Character-}π if Port[Addr + $05] = 0 then; {- Reset line status register-}ππ Port[Addr + $04] := Port[Addr + $04] or $01; {- Enable DTR-}π endπ else if InUse thenπ COMResult := 3 {- Port already in use-}π else if (Address > $3F8) thenπ COMResult := 5; {- Invalid port address-}π endπ else if (MaxAvail >= BufferSize) then {- not enough memory-}π COMResult := 1π else if IrqUsed(IrqNum) then {- Irq already used -}π COMResult := 4;πend;π{****************************************************************************}πProcedure ResetCOM(Nr : Byte);ππbeginπ With Ports[Nr] Doπ beginπ if InUse then {- Is port defined ?-}π beginπ InPtr := 1; {- Reset buffer Pointers-}π OutPtr := 1;π InitPort(Nr,False); {- Reinitialize the port-}ππ if Port[Addr + $00] = 0 then; {- Remove any pending Character-}π if Port[Addr + $05] = 0 then; {- Reset line status register-}π endπ elseπ COMResult := 2; {- Port not open-}π end;πend;π{****************************************************************************}πProcedure COMSettings(Nr : Byte; Baudrate : LongInt; ParityBit : Char;π Databits, Stopbits : Byte; HandShake : Boolean);πbeginπ With Ports[Nr] Doπ beginπ if InUse then {- Is port in use-}π beginπ Baud := Baudrate; {- Save parameters-}π Parity := Paritybit;π Databit := Databits;π Stopbit := Stopbits;π HShake := HandShake;ππ InitPort(Nr,False); {- ReInit port-}π endπ elseπ COMResult := 2; {- Port not in use-}π end;πend;π{****************************************************************************}πFunction COMAddress(COMport : Byte) : Word;ππbeginπ if Comport In [1..8] thenπ COMAddress := MemW[$40:(Pred(Comport) Shl 1)] {- BIOS data table-}π elseπ COMResult := 5; {- Invalid port-}πend;π{****************************************************************************}πFunction WriteCOM(Nr : Byte; Ch : Char) : Boolean;ππVarπ Count : Integer;ππbeginπ WriteCom := True;ππ With Ports[Nr] Doπ if InUse thenπ beginπ While Port[Addr + $05] and $20 = $00 Do; {- Wait Until Char send-}π if not HShake thenπ Port[Addr] := ord(Ch) {- Send Char to port-}π elseπ beginπ Port[Addr + $04] := $0B; {- OUT2, DTR, RTS-}π Count := MaxInt;ππ While (Port[Addr + $06] and $10 = 0) and (Count <> 0) Doπ Dec(Count); {- Wait For CTS-}ππ if Count <> 0 then {- if not timeout-}π Port[Addr] := ord(Ch) {- Send Char to port-}π elseπ beginπ COMResult := 6; {- Timeout error-}π WriteCom := False;π end;π end;π endπ elseπ beginπ COMResult := 2; {- Port not in use-}π WriteCom := False;π end;πend;π{****************************************************************************}πFunction WriteCOMString(Nr : Byte; St : String) : Boolean;ππVarπ Ok : Boolean;π Count : Byte;ππbeginπ if Length(St) > 0 then {- Any Chars to send ?-}π beginπ Ok := True;π Count := 1;π While (Count <= Length(St)) and Ok Do {- Count Chars-}π beginπ Ok := WriteCOM(Nr,St[Count]); {- Send Char-}π Inc(Count); {- Next Character-}π end;π WriteCOMString := Ok; {- Return status-}π end;πend;π{****************************************************************************}πFunction CheckCOM(Nr : Byte; Var Ch : Char) : Boolean;ππbeginπ With Ports[Nr] Doπ beginπ if InPtr <> OutPtr then {- Any Char in buffer ?-}π beginπ Ch := Chr(Buf^[OutPtr]); {- Get Char from buffer-}π Inc(OutPtr); {- Count outPointer up-}π if OutPtr > BufSize thenπ OutPtr := 1;π CheckCOM := True;π endπ elseπ CheckCOM := False; {- No Char in buffer-}π end;πend;π{****************************************************************************}πFunction COMError : Integer;ππbeginπ COMError := COMResult; {- Return last error-}π COMResult := 0;πend;π{****************************************************************************}πFunction COMUsed(Nr : Byte) : Boolean;ππbeginπ COMUsed := Ports[Nr].InUse; {- Return used status-}πend;π{****************************************************************************}πFunction IrqInUse(IrqNum : Byte) : Boolean;ππVarπ IrqOn : Byte;π Mask : Byte;ππbeginπ IrqInUse := False;ππ if IrqNum In [0..7] thenπ beginπ IrqOn := Port[$21]; {-1111 0100-}π Mask := ($01 Shl IrqNum);π IrqInUse := IrqOn or not Mask = not Mask;π end;πend;π{****************************************************************************}πProcedure SetIrqPriority(IrqNum : Byte);ππbeginπ if IrqNum In [0..7] thenπ beginπ if IrqNum > 0 thenπ Dec(IrqNum)π else IrqNum := 7;ππ DisableInterrupts;π Port[PIC] := $C0 + IrqNum;π EnableInterrupts;π end;πend;π{****************************************************************************}πProcedure ClearBuffer(Nr : Byte);ππbeginπ With Ports[Nr] Doπ if InUse and (BufSize > 0) thenπ OutPtr := InPtr;πend;π{****************************************************************************}πProcedure DeInit;ππVarπ Count : Byte;ππbeginπ For Count := 0 to 7 Doπ CloseCOM(Count); {- Close open ports-}ππ DisableInterrupts;π Port[$21] := OldPort21; {- Restore PIC status-}π Port[$20] := $C7; {- IRQ0 1. priority-}π EnableInterrupts;ππ ExitProc := ExitChainP; {- Restore ExitProc-}πend;ππ{****************************************************************************}πProcedure Init;ππVarπ Count : Byte;ππbeginπ COMResult := 0;π ExitChainP := ExitProc; {- Save ExitProc-}π ExitProc := @DeInit; {- Set ExitProc-}ππ For Count := 0 to 7 Doπ Ports[Count].InUse := False; {- No ports open-}ππ OldPort21 := Port[$21]; {- Save PIC status-}πend;ππ{****************************************************************************}ππbeginπ Init;πend.π 10 05-28-9313:35ALL SWAG SUPPORT TEAM Hangup Routine IMPORT 6 {π> I started writing communicating-Programs, and evenπ> trying to develope simple doors. But, i have oneπ> little problem: I don't know how to hang-up the modem!π> - I am using a ready-made TPU that does all the portπ> tasks, but it just can't hang up!π> All i know, is beFore the ~~~+++~~~ATH0 String, i need to 'Drop DTR'...π> How do i do that?!?ππif you are using a FOSSIL driver For communications, you could do this:π}ππProcedure Lower_DTR;πVar regs:Registers;πbeginπ regs.dx:=0; {com1=0;com2=1;com3=2;com4=3}π regs.al:=$00;π regs.ah:=$06;π intr($14,regs);π Exit;πend;ππ 11 05-28-9313:35ALL SWAG SUPPORT TEAM Another AVATAR Routine IMPORT 41 {πGREGORY P. SMITHππHere's a Unit I just pieced together from some old code I wrote a coupleπyears ago. It'll generate AVT/0+ and ANSI codes:π}ππUnit TermCode; {$S-,D-,L-,R-,F-,O-}π{ Generate ANSI and AVT/0+ codes For color and cursor ctrl }π{ Public Domain -- by Gregory P. Smith } { untested }ππInterfaceππTypeπ Str12 = String[12]; { Maximum size For most ANSI Strings }π Str3 = String[3];π grTermType = (TTY, ANSI, AVT0); { TTY, ANSI or Avatar/0+ }ππVarπ grTerm : grTermType;π grColor : Byte; { Last color set }ππ{ Non Specific Functions }πFunction grRepChar(c:Char;n:Byte): String; { Repeat Chars }πFunction grSetPos(x,y:Byte): Str12; { Set Cursor Position }πFunction grCLS: Str12; { Clear Screen + reset Attr }πFunction grDelEOL: Str12; { Delete to EOL }ππFunction grSetAttr(a:Byte): Str12; { Change writing color }πFunction grSetColor(fg,bg:Byte): Str12; { Change color fg & bg }ππ{ AVT/0+ Specific Functions }πFunction AVTRepPat(pat:String;n:Byte): String; { Repeat Pattern (AVT/0+) }πFunction AVTScrollUp(n,x1,y1,x2,y2:Byte): Str12;πFunction AVTScrollDown(n,x1,y1,x2,y2:Byte): Str12;πFunction AVTClearArea(a,l,c:Byte): Str12;πFunction AVTInitArea(ch:Char;a,l,c:Byte): Str12;ππImplementationππConstπ hdr = #27'['; { ansi header }ππ{ Misc support Functions }ππFunction bts(x:Byte): str3; { Byte to String }πVarπ z: str3;πbeginπ Str(x,z);π bts := z;πend;ππFunction Repl(n:Byte; c:Char): String;πVarπ z : String;πbeginπ fillChar(z[1],n,c);π z[0] := chr(n);π repl := z;πend;ππ{ Cursor Control Functions }ππFunction grRepChar(c:Char;n:Byte): String;πbeginπ if grTerm = AVT0 thenπ grRepChar := ^Y+c+chr(n)π elseπ grRepChar := repl(n,c);πend; { repcahr }ππFunction grSetPos(x,y:Byte): Str12;πbeginπ Case grTerm ofπ ANSI : if (x = 1) and (y > 1) thenπ grSetPos := hdr+bts(y)+'H' { x defualts to 1 }π elseπ grSetPos := hdr+bts(y)+';'+bts(x)+'H';π AVT0 : grSetPos := ^V+^H+chr(y)+chr(x);π TTY : grSetPos := '';π end; { Case }πend;πππFunction grCLS: Str12;πbeginπ Case grTerm ofπ ANSI : grCLS := hdr+'2J';π TTY,π AVT0 : grCLS := ^L;π end;π if grTerm = AVT0 then GrColor := 3; { reset the color }πend; { cls }ππFunction grDelEOL: Str12; { clear rest of line }πbeginπ Case grTerm ofπ ANSI : grDelEOL := hdr+'K';π AVT0 : grDelEOL := ^V^G;π TTY : grDelEOL := '';π end;πend;ππ{ Color Functions }ππFunction grSetAttr(a:Byte): Str12;πConstπ ANS_Colors : Array[0..7] of Char = ('0','4','2','6','1','5','3','7');πVarπ tmp : Str12;πbeginπ tmp := '';π Case grTerm ofπ ANSI :π beginπ tmp := hdr;π if (a and $08)=8 then tmp := tmp+'1' else tmp := tmp+'0'; { bright }π if (a and $80)=$80 then tmp := tmp+';5'; { blink }π tmp := tmp+';3'+ANS_Colors[a and $07]; { foreground }π tmp := tmp+';4'+ANS_Colors[(a shr 4) and $07]; { background }π grSetAttr := tmp+'m'; { complete ANSI code }π end;π AVT0 :π beginπ tmp := ^V+^A+chr(a and $7f);π if a > 127 then tmp := tmp+^V+^B; { Blink }π grSetAttr := tmp;π end;π TTY : grSetAttr := '';π end; { Case }π GrColor := a; { Current Attribute }πend; { setattr }ππFunction grSetColor(fg,bg:Byte): Str12;πbeginπ grSetColor := grSetAttr((bg shl 4) or (fg and $0f));πend; { SetColor }ππ{ AVATAR Specific Functions: }ππFunction AVTRepPat(pat:String;n:Byte): String; { Repeat Pattern (AVT/0+) }πbeginπ AVTRepPat := ^V+^Y+pat[0]+pat+chr(n); { Repeat pat n times }πend;ππFunction AVTScrollUp(n,x1,y1,x2,y2:Byte): Str12;πbeginπ AVTScrollUp := ^V+^J+chr(n)+chr(y1)+chr(x1)+chr(y2)+chr(x2);πend; { AVTScrollUp }ππFunction AVTScrollDown(n,x1,y1,x2,y2:Byte): Str12;πbeginπ AVTScrollDown := ^V+^K+chr(n)+chr(y1)+chr(x1)+chr(y2)+chr(x2);πend; { AVTScrollDown }ππFunction AVTClearArea(a,l,c:Byte): Str12;πVarπ b:Byte;π s:Str12;πbegin { Clear lines,columns from cursor pos With Attr }π b := a and $7f;π s := ^V+^L+chr(b)+chr(l)+chr(c);π if a > 127 thenπ Insert(^V+^B,s,1); { blink on }π AVTClearArea := s;π GrColor := a;πend; { AVTClearArea }ππFunction AVTInitArea(ch:Char;a,l,c:Byte): Str12;πVarπ b:Byte;π s:Str12;πbeginπ b := a and $7f;π s := ^V+^M+chr(b)+ch+chr(l)+chr(c);π if a > 127 thenπ Insert(^V+^B,s,1);π AvtInitArea := s;π GrColor := a;πend; { AVTInitArea }ππ{ Initalization code }πbeginπ GrTerm := AVT0; { Default to Avatar }π GrColor := 3; { Cyan is the AVT/0+ defualt }πend.ππ{πset GrTerm to whatever terminal codes you want to create; then you can use theπcommon routines to generate ANSI or Avatar codes. Here's a Print Procedureπthat you were mentioning:π}ππProcedure Print(Var msg:String);πVarπ idx : Byteπbeginπ if length(msg) > 0 thenπ For idx := 1 to length(msg) do beginπ Parse_AVT1(msg[idx]);π SendOutComPortThingy(msg[idx]);π end; { For }πend;π{πYou could modify this so that it pays attention to the TextAttr Variable of theπCrt Unit if you wish so that it compares TextAttr to GrColor and adds aπSetAttr(TextAttr) command in before it sends msg.π} 12 05-28-9313:35ALL SWAG SUPPORT TEAM Ring Detect IMPORT 13 (*******************************************************************)π Program RingDetector; { TSR to detect telephone ring via modem }π {$M $400,0,0}π Uses Dos; { import GetIntVec, SetIntVec }π Const COMport = $3FE; { COM1 = $3FE, COM2 = $2FE }π RingMsg : Array [0..7] of Byte =π ( $52,$40,$49,$40,$4E,$40,$47,$40 ); { "RinG" }π Var OldClock : Procedure; { For previous int vector }π GSpot : Byte Absolute $B800:$072C; { display area }π OldScreen : Array [0..7] of Byte; { to save display are }π {$F+}π Procedure RingDetect; Interrupt;π beginπ if ODD(Port[COMport] SHR 6)π then beginπ Move( GSpot, OldScreen, 8 ); { save screen area }π While ODD(PorT[COMport] SHR 6)π do Move( RingMsg, GSpot, 8 ); { display "RinG" }π Move( OldScreen, GSpot, 8 ); { restore screen }π end; {if}π InLine($9C); { to fake an inT }π OldClock; { chain ticker }π end {RingDetect};π {$F-}ππ beginπ GetIntVec($1C,@OldClock); { save current isr }π SetIntVec($1C,ADDR(RingDetect)); { install this isr }π Keep(0); { tsr }π end {RingDetector}.π(*******************************************************************)π 13 05-28-9313:35ALL SWAG SUPPORT TEAM Is Modem Ringing ?? IMPORT 10 Function ModemRinging(Port : Word) : Boolean; { through the BIOS }πVarπ Dummy : Byte;πbeginπ Asmπ dec portπ mov ah,03hπ mov dx,portπ int 14hπ mov dummy,alπ end;π ModemRinging := (Dummy and RI) = RI { ring indicated }πend;ππorππFunction ModemRinging(Port : Byte) : Boolean; { direct port access }πConstπ RI = $40;πbeginπ Case Port ofπ 1 : ModemRinging := ($3FE and RI) = RI; { com 1 }π 2 : ModemRinging := ($2FE and RI) = RI { com 2 }π endπend;ππFunction PhoneRinging(ComPort: Integer): Boolean;πbeginπ Case ComPort Ofπ 1: PhoneRinging := (Port[$3FE] And 64) = 64;π 2: PhoneRinging := (Port[$2FE] And 64) = 64;π 3: PhoneRinging := (Port[$3EE] And 64) = 64;π 4: PhoneRinging := (Port[$2EE] And 64) = 64;π Elseπ PhoneRinging := False;π end;πend;ππFunction returns True if phone is ringing. Hope it helps.ππ{π> Function returns True if phone is ringing. Hope it helps.ππJust nitpicking but...ππ PhoneRinging:=(Port[$3FE] and 64)<>0ππis more efficient, as isππ PhoneRinging:=Boolean(Port[$3FE] and 64)π} 14 05-28-9313:35ALL SWAG SUPPORT TEAM Serial Port Stuff IMPORT 35 {π│ Does anyone have a few minutes to help a novice? I'm new to Pascalπ│ and have just added a new dimension to my Programming interestsπ│ through the purchase of Borland's Pascal With Objects 7.0 and as Iπ│ struggle through the 3000 odd pages of documentation I find I'mπ│ missing some of the basics. For example, I'm trying to Write aπ│ little phone dialer as an exercise in using OOP and am having troubleπ│ talking to the modem With the following:π│ Assign(Port,COM1); ReWrite(Port); Write(Port,ATDT);π│ This works fine only if I run my dialer Program after having usingπ│ another comms Program With my modem. if I try to run it cold I getπ│ Error 160: Device Write fault. There is obviously some initializationπ│ I need to do to "WAKEUP" the modem.πππ...Here's some routines to initialize/manipulates the RS-232 port.π}πππProcedure InitCommPort(IniStr : Byte;π CommPort : Word;π Var LineStatusπ ModemStatus : Byte);π(****************************************************************************π Parameters:ππ InitStr - Initialization paramterππ Bits 7654321 Meaningπ 000 110 baudπ 001 150 baudπ 010 300 baudπ 011 600 baudπ 100 1200 baudπ 101 2400 baudπ 110 4800 baudπ 111 9600 baudπ 00 no parityπ 01 odd parityπ 10 no parityπ 11 even parityπ 0 1 stop bitπ 1 2 stop bitπ 10 7-bit data lengthπ 11 8-bit data lengthππ ie: For 1200/N/8/1 use InitStr = 10000011bππ CommPort - Communication port (0=com1, 1=com2, 2=com3 etc)ππ LineStatus Bits 76543210 Meaningπ 1 time-out errorπ 1 transfer shift register emptyπ 1 transfer holding register emptyπ 1 break interrupt detectedπ 1 framing errorπ 1 parity errorπ 1 overrun errorπ 1 data readyππ ModemStatus Bits 76543210 Meaningπ 1 receive line signal detectπ 1 ring indicatorπ 1 data set ready (DSR)π 1 clear to send (CTS)π 1 delta receive line signal detectπ 1 trailing edge ring detectorπ 1 delta data set ready (DDSR)π 1 delta clear to send (DCTS)ππ*****************************************************************************)ππVarπ regs : Registers; (* Uses Dos Unit *)πbeginπ regs.AH := $00;π regs.AL := InitStr;π regs.DX := CommPort;π Intr($14, regs); (* initialize comm port *)π LineStatus := regs.AH;π ModemStatus := regs.AL;πend; (* InitCommPort *)πππProcedure TransmitChar(Ch: Byte; (* Character to send *)π CommPort: Word; (* comm port to use *)π Var Code: Byte) (* return code *)π(****************************************************************************ππ notE: BeFore calling this routine, the port must be first initializedπ by InitCommPort.ππ****************************************************************************)πVarπ regs : Registers;πbeginπ regs.AH := $01;π regs.AL := Ch;π regs.DX := CommPort; (* 0=com1, etc *)π Intr($14, regs); (* send Character *)π Code := regs.AH (* return code *)πend; (* TransmitChar *)π 15 05-28-9313:35ALL SWAG SUPPORT TEAM DOOR Info & File Maker IMPORT 20 {πREYNIR STEFANSSONππSome time ago I looked at the Waffle BBS v1.63. I wrote this progletπto create a DOORINFO File For certain aftermarket utilities. Here you are:π}ππProgram DIMaker; {Writes DOORINFO.DEF/DORINFOn.DEF For Waffle BBS. }ππVarπ tf : Text;π Graphic : Integer;π Port : Char;π SysName,π SysOpFirst,π SysOpLast,π Baud,π Terminal,π First,π Last,π CallLoc,π TimeLeft,π SecLev,π FossilOn,π SysDir,π FileName : String;ππ{ Command line For Waffle: }ππ{ dimaker ~%b ~%t ~%O ~%a ~%F ~%A@~%n ~%L -1 [-|n] }ππProcedure WriteDorInfo;πbeginπ Assign(tf, SysDir+FileName+'.DEF');π ReWrite(tf);π WriteLn(tf, SysName); { BBS name }π WriteLn(tf, SysOpFirst); { SysOp's first name }π WriteLn(tf, SysOpLast); { SysOp's last name }π WriteLn(tf, 'COM', Port); { COMport in use }π WriteLn(tf, Baud, ' BAUD,8,N,1'); { Speed and Char format }π WriteLn(tf, '0'); { ? }π WriteLn(tf, First); { User's first name }π WriteLn(tf, Last); { User's last name }π WriteLn(tf, CallLoc); { User's location }π WriteLn(tf, Graphic); { 1 if ANSI, 0 if not. }π WriteLn(tf, SecLev); { Security level }π WriteLn(tf, TimeLeft); { Time Until kick-out }π WriteLn(tf, FossilOn); { -1 if using FOSSIL, 0 if not }π Close(tf);πend;ππ{ Don't let my reusing of Variables disturb you. }πProcedure GatherInfo;πbeginπ FileName[1] := '-';π SysName := ParamStr(0);π Graphic := Length(SysName);π Repeatπ Dec(Graphic)π Until SysName[Graphic]='\';π SysDir := Copy(SysName, 1, Graphic);π Assign(tf, Copy(SysName, 1, Length(SysName)-4)+'.CFG');π Reset(tf);π ReadLn(tf, SysName);π ReadLn(tf, SysOpFirst);π ReadLn(tf, SysOpLast);π Close(tf);π Baud := ParamStr(1);π Terminal := ParamStr(2);π TimeLeft := ParamStr(3);π SecLev := ParamStr(4);π First := ParamStr(5);π Last := ParamStr(6);π CallLoc := ParamStr(7);π FossilOn := ParamStr(8);π FileName := ParamStr(9);π Port := FileName[1];π if Port = '-' thenπ FileName := 'DOORINFO'π elseπ FileName := 'DORINFO'+Port;π if Terminal='vt100' thenπ Graphic := 1π elseπ Graphic := 0;π Port := '2';π if Baud='LOCAL' thenπ beginπ Baud := '0';π Port := '0';π end;πend;ππbegin;π GatherInfo;π WriteDorInfo;πend.π
