SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00060 COMMUNICATIONS/INT14 ROUTINES 1 05-28-9313:35ALL SEAN PALMER Routines for AVATAR IMPORT 35 ╣J╜╝ {π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 ╣J:∙ {π>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 ╣J╕ {π> 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 ╣J«X { >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 SEAN PALMER Another Carrier Detect IMPORT 4 ╣J₧ß {π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 ╣J£% { 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 ╣J¬9 {π 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 ╣Já# {π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 ╣J└π {π>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 ╣J} {π> 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 ╣JtP {π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 ╣J
α (*******************************************************************)π 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 ╣Jú7 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 ╣J╘y {π│ 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 ╣J╡ {π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.π 16 07-16-9306:00ALL KAI HENNINGSEN Detect 16550A UART IMPORT 24 ╣J {πFrom: Kai_Henningsen@ms.maus.de (Kai Henningsen)πNewsgroups: comp.dcom.modemsπSubject: Help upgrade to 16550AπDate: Tue, 04 Aug 92 16:13:00 GMTπOrganization: MausNetππAny noncommercial use allowed. For commercial, ask me - or use somethingπelse. The ideas in this program are really very simple ... I seem toπremember most came from an article in DDJ.π}ππprogram ShowUARTs;ππusesπ m7UtilLo;ππtypeπ tUART = (uNoUART, uBadUART, u8250, u16450, u16550, u16550a);ππconstπ MCR = 4;π MSR = 6;π Scratch = 7;π FCR = 2;π IIR = 2;π LOOPBIT = $10;ππfunction UARTat(UART: Word): tUART;πvarπ HoldMCR,π HoldMSR,π Holder : Byte;πbegin {|UARTat}π HoldMCR := Port[UART + MCR];π Port[UART + MCR] := HoldMCR or LOOPBIT;π HoldMSR := Port[UART + MSR];π Port[UART + MCR] := $0A or LOOPBIT;π Holder := Port[UART + MSR] and $F0;π Port[UART + MSR] := HoldMSR;π Port[UART + MCR] := HoldMCR and not LOOPBIT;π if Holder <> $90 then beginπ UARTat := uNoUART;π Exitπ end {|if Holder<>$90};π Port[UART + Scratch] := $AA;π if Port[UART + Scratch] <> $AA thenπ UARTat := u8250π else beginπ Port[UART + FCR] := $01;π Holder := Port[UART + IIR] and $C0;π case Holder ofπ $C0: UARTat := u16550a;π $80: UARTat := u16550;π $00: UARTat := u16450;π else UARTat := uBadUART;π end {|case Holder};π Port[UART + FCR] := $00;π end {|if Port[UART+Scratch]<>$AA else};πend {|UARTat};ππprocedure DisplayUARTat(UART: Word; name: string; num: Integer);πbegin {|DisplayUARTat}π Write(Hex(UART, 4), ' ', name, num);π if UART = 0 thenπ Writeln(' not defined')π elseπ case UARTat(UART) ofπ uNoUART: Writeln(' not present');π uBadUART: Writeln(' broken');π u8250: Writeln(' 8250B');π u16450: Writeln(' 16450');π u16550: Writeln(' 16550');π u16550a: Writeln(' 16550A');π else Writeln(' unknown');π end {|case UARTat(UART)};πend {|DisplayUARTat};ππvarπ i : Integer;π BIOSPortTab : array [1 .. 4] of Word absolute $40: 0;πbegin {|ShowUARTs}π Writeln; Writeln;π Writeln('COM Port Detector');π Writeln;π for i := 1 to 4 doπ DisplayUARTat($02E8 + $100 * (i and 1) + $10 * Ord(i < 3), 'Standard COM',π i);π Writeln;π for i := 3 to 8 doπ DisplayUARTat($3220 + $1000 * ((i - 3) div 2) + $8 * Ord(not Odd(i)),π 'PS/2 COM', i);π Writeln;π for i := 1 to 4 doπ DisplayUARTat(BIOSPortTab[i], 'BIOS COM', i);πend {|ShowUARTs}.ππm7utillo is a general utility unit I use a lot; all you need is this routine:ππfunction Hex(v: Longint; w: Integer): String;πvarπ s : String;π i : Integer;πconstπ hexc : array [0 .. 15] of Char= '0123456789abcdef';πbeginπ s[0] := Chr(w);π for i := w downto 1 do beginπ s[i] := hexc[v and $F];π v := v shr 4π end;π Hex := s;πend {Hex};π 17 08-17-9308:44ALL STEVE CONNET Very Complete FOSSIL UnitIMPORT 90 ╣J¼ Unit FWizard;ππ{/π Fossil Wizard Unit v1.0 by Steve Connet - Tuesday, Jan. 19, 1993ππ This program provides an easy interface to access the routinesπ provided by a fossil driver.π//}ππINTERFACEπFunction SetBaud(Port, Baud : Word; Parms : Byte) : Boolean;πFunction OutBufferFull(Port : Word) : Boolean;πFunction CharWaiting(Port : Word) : Boolean;πFunction ComReadChar(Port : Word) : Char;πFunction CarrierDetected(Port : Word) : Boolean;πFunction ModemRinging(Port : Word) : Boolean;πFunction FossilPresent : Boolean;πFunction RemoteAnsiDetected(Port : Word) : Boolean;πFunction LocalAnsiDetected : Boolean;πFunction RemoteAvatarDetected(Port : Word) : Boolean;ππProcedure ActivatePort(Port : Word);πProcedure DTR(Port : Word; Action : Byte);πProcedure ReBoot(Action : Byte);πProcedure DeActivatePort(Port : Word);πProcedure ComWriteChar(Port : Word; Ch : Char);πProcedure ClearOutBuffer(Port : Word);πProcedure ClearInBuffer(Port : Word);πProcedure FlowControl(Port : Word; XON_XOFFR, XON_XOFFT, RTS_CTS : Boolean);πProcedure WatchDog(Port : Word; Action : Byte);πProcedure Chat(Port : Word);πProcedure ComWrite(Port : Word; Msg : String);πProcedure ComWriteln(Port : Word; Msg : String);πProcedure Wait(Seconds : Word);πProcedure GetCursor(VAR x, y : Byte);πProcedure SetCursor(Port : Word; x, y : Byte);πProcedure SendBreak(Port : Word);πProcedure ComReadln(Port : Word; VAR Msg : String; Count : Byte);πProcedure CLS(Port : Word);ππCONSTπ N81=$03; E81 =$1b; O81 =$0b; LOWER=$00; CTS =$10; RDA =$01; XONR=$01;π N82=$07; E82 =$1f; O82 =$0f; RAISE=$01; DSR =$20; THRE=$20; XONT=$08;π N71=$02; E71 =$1a; O71 =$0a; COLD =$00; RI =$40; TSRE=$40; RTS =$02;π N72=$06; E72 =$1e; O72 =$0e; WARM =$01; DCD =$80; ON =$01; OFF =$00;π Esc=#27; COM1=$00; COM2=$01; COM3 =$02; COM4=$03;ππIMPLEMENTATIONπUses Crt;ππFunction SetBaud(Port, Baud : Word; Parms : Byte) : Boolean;πVAR Dummy : Word;πBeginπ Case Baud ofπ 300: Baud := $40; { 01000000 }π 600: Baud := $60; { 01100000 }π 1200: Baud := $80; { 10000000 }π 2400: Baud := $a0; { 10100000 }π 4800: Baud := $c0; { 11000000 }π 9600: Baud := $e0; { 11100000 }π 19200: Baud := $00; { 00000000 }π 38400,π 14400,π 16800: Baud := $20; { 00100000 }π End;π Parms := Parms OR Baud; { merge baud bits with parm bits }π Asmπ mov ah,00hπ mov al,parmsπ mov dx,portπ int 14hπ mov dummy,axπ End;π SetBaud := ((Dummy AND CTS) = CTS) or { clear to send }π ((Dummy AND DSR) = DSR) or { data set ready }π ((Dummy AND RI) = RI) or { ring indicator }π ((Dummy AND DCD) = DCD) { data carrier detect }πEnd;ππFunction OutBufferFull(Port : Word) : Boolean;πVAR Dummy : Byte;πBeginπ Asmπ mov ah,03hπ mov dx,portπ int 14hπ mov dummy,ahπ End;π OutBufferFull := ((Dummy AND THRE) <> THRE) or { room in out buffer }π ((Dummy AND TSRE) <> TSRE) { out buffer empty }πEnd;ππFunction CharWaiting(Port : Word) : Boolean;πVAR Dummy : Byte;πBeginπ Asmπ mov ah,03hπ mov dx,portπ int 14hπ mov dummy,ahπ End;π CharWaiting := (Dummy AND RDA) = RDA { character waiting }πEnd;ππFunction ComReadChar(Port : Word) : Char;πVAR Dummy : Byte;πBeginπ Asmπ mov ah,02hπ mov dx,portπ int 14hπ mov dummy,alπ End;π ComReadChar := Char(Dummy)πEnd;ππFunction CarrierDetected(Port : Word) : Boolean;πVAR Dummy : Byte;πBeginπ Asmπ mov ah,03hπ mov dx,portπ int 14hπ mov dummy,alπ End;π CarrierDetected := (Dummy AND DCD) = DCD { carrier detected }πEnd;ππFunction ModemRinging(Port : Word) : Boolean;πVAR Dummy : Byte;πBeginπ Asmπ mov ah,03hπ mov dx,portπ int 14hπ mov dummy,alπ End;π ModemRinging := (Dummy AND RI) = RI { ring indicated }πEnd;ππFunction FossilPresent : Boolean;πVAR Dummy : Word;πBeginπ Asmπ mov ah,04hπ mov dx,00ffhπ int 14hπ mov dummy,axπ End;π FossilPresent := Dummy = $1954;πEnd;ππFunction RemoteAnsiDetected(Port : Word) : Boolean;πVAR Dummy : Char;πBeginπ If Not OutBufferFull(Port) thenπ Beginπ ComWriteChar(Port, #27); ComWriteChar(Port, '[');π ComWriteChar(Port, '6'); ComWriteChar(Port, 'n')π End;π If CharWaiting(Port) thenπ RemoteAnsiDetected := ComReadChar(Port) in [#27,'0'..'9','[','H'] elseπ RemoteAnsiDetected := False;π ClearInBuffer(Port)πEnd;ππFunction LocalAnsiDetected : Boolean;πVAR Dummy : Byte;πBeginπ Asmπ mov ah,1ah { detect ANSI.SYS device driver }π mov al,00hπ int 2fhπ mov dummy,alπ End;π LocalAnsiDetected := Dummy = $FFπEnd;ππFunction RemoteAvatarDetected(Port : Word) : Boolean;πBeginπ If Not OutBufferFull(Port) thenπ Beginπ ComWriteChar(Port, ' '); ComWriteChar(Port, ' ');π ComWriteChar(Port, ' ');π End;π If CharWaiting(Port) thenπ RemoteAvatarDetected := ComReadChar(Port) in ['A','V','T'] elseπ RemoteAvatarDetected := False;π ClearInBuffer(Port)πEnd;πππProcedure ActivatePort(Port : Word); Assembler;πAsmπ mov ah,04hπ mov dx,portπ int 14hπEnd;ππProcedure DTR(Port : Word; Action : Byte); Assembler;πAsmπ mov ah,06hπ mov al,actionπ mov dx,portπ int 14hπEnd;ππProcedure ReBoot(Action : Byte); Assembler;πAsmπ mov ah,17hπ mov al,actionπ int 14hπEnd;ππProcedure DeActivatePort(Port : Word); Assembler;πAsmπ mov ax,05hπ mov dx,portπ int 14hπEnd;ππProcedure ComWriteChar(Port : Word; Ch : Char);πVAR Dummy : Byte;πBeginπ Dummy := Ord(Ch);π Asmπ mov ah,01hπ mov al,dummyπ mov dx,portπ int 14hπ End;πEnd;ππProcedure ClearOutBuffer(Port : Word); Assembler;πAsmπ mov ah,09hπ mov dx,portπ int 14hπEnd;ππProcedure ClearInBuffer(Port : Word); Assembler;πAsmπ mov ah,0ahπ mov dx,portπ int 14hπEnd;ππProcedure FlowControl(Port : Word; XON_XOFFR, XON_XOFFT, RTS_CTS : Boolean);πVAR Dummy : Byte;πBeginπ Dummy := $00;π If XON_XOFFR then { Xon/Xoff receive enable }π Dummy := Dummy OR XONR else { set bit 0 on }π Dummy := Dummy AND XONR; { set bit 0 off }π If XON_XOFFT then { Xon/Xoff transmit enable }π Dummy := Dummy OR XONT else { set bit 3 on }π Dummy := Dummy AND XONT; { set bit 3 off }π If RTS_CTS then { RTS_CTS enabled }π Dummy := Dummy OR RTS else { set bit 1 on }π Dummy := Dummy AND RTS; { set bit 1 off }π Asmπ mov ah,0fhπ mov al,dummyπ mov dx,portπ int 14hπ EndπEnd;ππProcedure WatchDog(Port : Word; Action : Byte); Assembler;πAsmπ mov ah,14hπ mov al,actionπ mov dx,portπ int 14hπEnd;ππProcedure Chat(Port : Word);ππVAR Ch,π AnsiCh : Char;π Ansi : Text;πBeginπ Assign(Ansi,'');π ReWrite(Ansi);π Repeatπ If Keypressed thenπ Beginπ Ch := Readkey;π If Ch <> Esc thenπ ComWriteChar(Port,ch)π End;π If CharWaiting(Port) thenπ Beginπ AnsiCh := ComReadChar(Port);π If FossilPresent thenπ Asmπ mov ah,13hπ mov al,ansichπ int 14hπ End elseπ Write(Ansi,AnsiCh) { no fossil driver }π Endπ Until Ch = Esc;π Close(Ansi)πEnd;ππProcedure ComWrite(Port : Word; Msg : String);πVAR Dummy, x,π SegMsg,π OfsMsg : Word;π Ansich : Char;π Ansi : Text;πBeginπ Assign(Ansi,'');π ReWrite(Ansi);π Dummy := Ord(Msg[0]); { length (msg) }π If FossilPresent thenπ Beginπ SegMsg := Seg(Msg);π OfsMsg := Ofs(Msg) + 1; { don't include length of msg }π Asm { use fossil driver }π mov ah,19hπ mov dx,portπ mov cx,dummyπ mov es,SegMsgπ mov di,OfsMsgπ int 14hπ End;π While CharWaiting(Port) doπ Beginπ AnsiCh := ComReadChar(Port);π Asmπ mov ah,13hπ mov al,ansichπ int 14hπ Endπ Endπ End elseπ For x := 1 to dummy doπ Beginπ ComWriteChar(Port,Msg[x]);π If CharWaiting(Port) thenπ Write(Ansi,ComReadChar(Port))π End;π Close(Ansi)πEnd;ππProcedure ComWriteln(Port : Word; Msg : String);πBeginπ Msg := Msg + #13 + #10;π ComWrite(Port, Msg)πEnd;ππProcedure Wait(Seconds : Word);πVAR Delay : Word;πBeginπ Delay := ((976 SHL 10) * Seconds) SHR 16; { (976*1024*seconds)/65536 }π Asmπ mov ah,86hπ mov cx,delayπ mov dx,0π int 15hπ EndπEnd;ππProcedure GetCursor(VAR x, y : Byte);πVAR x1, y1 : Byte;πBeginπ If FossilPresent thenπ Asmπ mov ah,12hπ int 14hπ mov x1,dlπ mov y1,dhπ End elseπ Asmπ mov ah,03hπ mov bh,00hπ int 10hπ mov x1,dlπ mov y1,dhπ End;π x := x1; y := y1πEnd;ππProcedure SetCursor(Port : Word; x, y : Byte);πVAR x1,y1 : String;πBeginπ If FossilPresent thenπ Asmπ mov ah,11hπ mov dh,yπ mov dl,xπ int 14hπ End elseπ Asmπ mov ah,02hπ mov bh,00hπ mov dh,yπ mov dl,xπ int 10hπ End;π If (CarrierDetected(port)) and (RemoteAnsiDetected(Port)) thenπ Beginπ Str(x,x1);π Str(y,y1);π ComWrite(Port,' ['+y1+';'+x1+'H') { ESC[y;xH }π EndπEnd;ππProcedure SendBreak(Port : Word); Assembler;πAsmπ mov ah,1ah {; start sending break }π mov al,01hπ mov dx,portπ int 14hπ mov ah,86h {; wait 1 second }π mov cx,0fhπ mov dx,00hπ int 15hπ mov ah,1ah {; stop sending break }π mov al,00hπ mov dx,portπ int 14hπ mov ah,0ah {; purge input buffer }π mov dx,portπ int 14hπEnd;ππProcedure ComReadln(Port : Word; VAR Msg : String; Count : Byte);πVAR WLength,π SegMsg,π OfsMsg : Word;πBeginπ SegMsg := Seg(Msg);π OfsMsg := Ofs(Msg);π WLength := Count;π Asmπ mov ah,18hπ mov di,ofsmsgπ mov es,segmsgπ mov cx,wlengthπ mov dx,portπ int 14hπ End;πEnd;ππProcedure CLS(Port : Word);πBeginπ ClrScr;π If CarrierDetected(Port) thenπ If RemoteAnsiDetected(Port) thenπ ComWrite(Port,' [2J') elseπ ComWriteChar(Port,' ');πEnd;ππBeginπ Writeln('Fossil Wizard v1.0 by Steve Connet - Jan. 19, 1993');π Writeln('This is removed when you register.');π Wait(2)πEnd.πππ(* This is an example of how to use Fossil Wizard *)ππUses FWizard, Crt;ππVARπ Ch : Char;π Baud : Word;ππBeginπ Baud := 2400; { change this to the appropriate baud }π ClrScr;ππ SetCursor(Com2,50,19);π If FossilPresent thenπ Beginπ ActivatePort(Com2); { wake up fossil driver }π Write('[FOSSIL PRESENT]')π End elseπ Write('[FOSSIL NOT PRESENT]');ππ SetCursor(Com2,50,20);π If SetBaud(Com2,Baud,N81) then { set baud rate }π Write('[MODEM READY]') elseπ Write('[MODEM NOT RESPONDING]');ππ SetCursor(Com2,50,21);π If CarrierDetected(Com2) thenπ Write('[CARRIER DETECTED]') elseπ Write('[NO CARRIER]');ππ SetCursor(Com2,50,22);π If (CarrierDetected(Com2)) and (RemoteAvatarDetected(Com2)) thenπ Write('[REMOTE AVATAR DETECTED]') elseπ Write('[REMOTE AVATAR NOT DETECTED]');ππ SetCursor(Com2,50,23);π If (CarrierDetected(Com2)) and (RemoteAnsiDetected(Com2)) thenπ Write('[REMOTE ANSI DETECTED]') elseπ Write('[REMOTE ANSI NOT DETECTED]');ππ SetCursor(Com2,50,24);π If LocalAnsiDetected thenπ Write('[LOCAL ANSI DETECTED]') elseπ Write('[LOCAL ANSI NOT DETECTED]');ππ SetCursor(Com2,0,0);π Chat(Com2); { built in chat mode }π DTR(Com2,Lower); { lower data terminal ready }π DeActivatePort(Com2); { put fossil driver to sleep }π ClrScrπEnd.π 18 08-18-9312:29ALL JOSE ALMEIDA Serial Base Addresses IMPORT 5 ╣J├∩ FUNCTION Serial_Base_Addr(COM_Port : byte) : word;π{ DESCRIPTION:π Base address for four serial ports.π SAMPLE CALL:π NW := Serial_Base_Addr(1);π RETURNS:π The base address for the specified serial port.π NOTES:π If the port is not used, then the returned value will be 0 (zero).π The aceptable values for COM_Port are: 1,2,3 and 4. }ππBEGIN { Serial_Base_Addr }π Serial_Base_Addr := MemW[$0000:$0400 + Pred(COM_Port) * 2];πEND; { Serial_Base_Addr }π 19 08-18-9312:29ALL JOSE ALMEIDA Get number of RS232 PortsIMPORT 3 ╣J├! FUNCTION Serial_Ports : byte;π{ DESCRIPTION:π Gets the number of RS232 ports available in a system.π SAMPLE CALL:π NB := Serial_Ports; }ππBEGIN { Serial_Ports }π Serial_Ports := (MemW[$0000:$0410] shl 4) shr 13;πEND; { Serial_Ports }π 20 08-18-9312:30ALL JOSE ALMEIDA Get Serial Port Timeout IMPORT 4 ╣J² FUNCTION Serial_Time_Out(COM : byte) : byte;π{ DESCRIPTION:π Time-Out values for RS232 communications lines.π SAMPLE CALL:π NB := Serial_Time_Out(1);π NOTES:π The allowed values for COM are: 1,2,3 or 4. }ππBEGIN { Serial_Time_Out }π Serial_Time_Out := Mem[$0000:$047C + Pred(COM)];πEND; { Serial_Time_Out }π 21 08-23-9309:16ALL ERIC GIVLER Get Device Function IMPORT 15 ╣JΓ/ {π===========================================================================π BBS: Canada Remote SystemsπDate: 08-16-93 (19:59) Number: 34567πFrom: ERIC GIVLER Refer#: NONEπ To: ALL Recvd: NOπSubj: PROBLEM Conf: (1221) F-PASCALπ---------------------------------------------------------------------------πWhen I start up the BBS and it has the wrong port# (ie Com1 instead of 2),πthe machine will lockup trying to write to the modem. If the port isπcorrect, there are NO problems as long as the modem is on. Is there aπgraceful way of detecting this and remedying it - ie. Even an abortπto DOS with an errorlevel would be nicer than a LOCKUP! The followingπidea is what I've tried. It DOES appear to work!π}πUSES CRT,DOS;ππfunction is_device_ready( devicename:string) : boolean;πvar r : registers; handle : word; ready : byte;πbeginπ ready := 0;π r.ds := seg(devicename);π r.dx := ofs(devicename[1]);π r.ax := $3d01;π msdos(r);π if (r.flags and fCarry) <> fCarry thenπ beginπ handle := r.ax;π ready := 1;π r.ax := $4407;π r.bx := handle;π msdos(r);π ready := ready and r.AL;π r.ah := $3e;π r.bx := handle;π msdos(r);π end;π is_device_ready := ( ready = 1 );πend; { is_device_ready }ππbeginπ ClrScr;π writeln('COM2 is ready ..', is_device_ready('COM2'+#00) );π writeln('COM1 is ready ..', is_device_ready('COM1'+#00) );π writeln('LPT1 is ready ..', is_device_ready('PRN' + #00) );πend.ππ--- msgedsq 2.1π * Origin: Noname Consultants (717)561-8033 (1:270/101.15)π 22 08-27-9320:06ALL SEAN PALMER Simple Avatar code IMPORT 24 ╣J╠° w{πSEAN PALMERππUsing the state-driven approach, I came up With this simplisticπAvatar/0 interpreter as an example. Do With it as you wish...ππby Sean L. PalmerπPublic Domainπ}ππProgram avtWrite;π{ example to do avatar/0 (FSC-0025) interpretation }π{ could easily be extended to handle /0+ and /1 codes }ππUsesπ Crt;ππ{ this part of the Program controls the state-driven part of the displayπ handler. }ππVarπ saveAdr : Pointer; { where state handler is now }π c : Char; { Char accessed by state handler }π b : Byte Absolute c;ππProcedure avtWriteCh(c2 : Char); Inline(π $8F/$06/>C/ { pop Byte ptr [>c] }π $FF/$1E/>SAVEADR); { call dWord ptr [>saveAdr] }π { continue where handler lππ call this Procedure from StateHandler toπ suspend execution Until next timeπ}ππProcedure wait; near; Assembler;πAsm { wait For next Char }π pop Word ptr saveAdr { save where to continue next time }π retF { simulate Exit from calling proc }πend;ππ{π a stateHandler Procedure should never ever Exit (only by calling 'wait'),π shouldn't have any local Variables or parameters, and shouldn't callπ 'wait' With anything on the stack (like from a subroutine).π This routine is using the caller's stack, so be carefulπ}ππVarπ avc : Char;π avb : Byte Absolute avc;ππProcedure stateHandler;πbeginππ Repeatππ Case c ofππ ^L :π beginπ ClrScr;π Textattr := 3;π end;ππ ^Y :π beginπ wait;π avc := c;π wait;π While c <> #0 doπ beginπ dec(c);π Write(avc);π end;π end;ππ ^V :π beginπ wait;π Case c ofππ ^A :π beginπ wait;π Textattr := Byte(c);π end;π ^B : Textattr := Textattr or $80;π ^C : if whereY > 1 then GotoXY(whereX, whereY - 1);π ^D : if whereY < 25 then GotoXY(whereX, whereY + 1);π ^E : if whereX > 1 then GotoXY(whereX - 1,whereY);π ^F : if whereX < 80 then GotoXY(whereX + 1,whereY);π ^G : clreol;π ^H :π beginπ wait;π avb := b;π wait;π GotoXY(b + 1, avb + 1);π end;π elseπ Write(^V, c);π end;π end;π elseπ Write(c);π end;π wait;π Until False;πend;ππVarπ i : Integer;πConstπ s : String = 'Oh my'^V^D^V^D^V^F^V^A#1'it works'^V^A#4',see?';πbegin {could do something like attach it to Output's InOutFunc...}π saveAdr := ptr(seg(stateHandler), ofs(stateHandler) + 3); {skip header}π For i := 1 to length(s) doπ avtWriteCh(s[i]);πend.π 23 08-27-9321:24ALL RONEN MAGID Fossil unit IMPORT 78 ╣J<$ {π Version 1.2 26-August-1989ππ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄π█▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█π█▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█π█▒▒▒▒▒▒▒▒█████████████████████████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█π█▒▒▒▒▒▒▒ ███ ▒▒▒▒▒▒▒▒▒▒▒▒▒███▒▒▒▒┌──────────────────┐▒█π█▒▒▒▒▒▒▒ ███▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ ███▒▒▒▒│ Ronen Magid's │▒█π█▒▒▒▒▒▒▒ ███▒▒▒▒▒████████▒▒███████▒▒███████▒▒███▒ ███▒▒▒▒│ │▒█π█▒▒▒▒▒▒▒ ███▒▒▒▒ ███ ███▒ ███ ▒▒ ███ ▒▒ ███▒ ███▒▒▒▒│ Fossil │▒█π█▒▒▒▒▒▒▒ ██████▒ ███▒ ███▒ ███▒▒▒▒▒ ███▒▒▒▒▒ ███▒ ███▒▒▒▒│ support │▒█π█▒▒▒▒▒▒▒ ███ ▒▒ ███▒ ███▒ ███████▒ ███████▒ ███▒ ███▒▒▒▒│ Unit For │▒█π█▒▒▒▒▒▒▒ ███▒▒▒▒ ███▒ ███▒ ███▒ ███▒ ███▒ ███▒▒▒▒│ │▒█π█▒▒▒▒▒▒▒ ███▒▒▒▒ ███▒ ███▒▒▒▒ ███▒▒▒▒ ███▒ ███▒ ███▒▒▒▒│ TURBO PASCAL │▒█π█▒▒▒▒▒▒▒ ███▒▒▒▒ ████████▒▒███████▒▒███████▒ ███▒ ███▒▒▒▒│ versions │▒█π█▒▒▒▒▒▒▒ ▒▒▒▒▒ ▒▒ ▒▒ ▒▒ ▒▒ ▒▒▒▒▒│ 4,5 │▒█π█▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒└──────────────────┘▒█π█▒▒▒████████████████████████████████████████████████████▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█π█▒▒ ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█π█▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒█π▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ππ Copyright (c) 1989 by Ronen Magid. Tel (972)-52-917663 VOICEπ 972-52-27271 2400 24hrsπππ}ππUnit FOSCOM;ππInterfaceππUsesπ Dos, Crt;ππVarπ Regs : Registers; {Registers used by Intr and Ms-Dos}ππππ{ Available user Procedures and Functions }ππProcedure Fos_Init (Comport: Byte);πProcedure Fos_Close (Comport: Byte);πProcedure Fos_Parms (Comport: Byte; Baud: Integer; DataBits: Byte;π Parity: Char; StopBit: Byte);πProcedure Fos_Dtr (Comport: Byte; State: Boolean);πProcedure Fos_Flow (Comport: Byte; State: Boolean);πFunction Fos_CD (Comport: Byte) : Boolean;πProcedure Fos_Kill_Out (Comport: Byte);πProcedure Fos_Kill_In (Comport: Byte);πProcedure Fos_Flush (Comport: Byte);πFunction Fos_Avail (Comport: Byte) : Boolean;πFunction Fos_OkToSend (Comport: Byte) : Boolean;πFunction Fos_Empty (Comport: Byte) : Boolean;πProcedure Fos_Write (Comport: Byte; Character: Char);πProcedure Fos_String (Comport: Byte; OutString: String);πProcedure Fos_StringCRLF (Comport: Byte; OutString: String);πProcedure Fos_Ansi (Character: Char);πProcedure Fos_Bios (Character: Char);πProcedure Fos_WatchDog (Comport: Byte; State: Boolean);πFunction Fos_Receive (Comport: Byte) : Char;πFunction Fos_Hangup (Comport: Byte) : Boolean;πProcedure Fos_Reboot;πFunction Fos_CheckModem (Comport: Byte) : Boolean;πFunction Fos_AtCmd (Comport: Byte; Command: String) : Boolean;πProcedure Fos_Clear_Regs;πππImplementationππProcedure Fos_Clear_Regs;πbeginπ FillChar (Regs, SizeOf (Regs), 0);πend;ππProcedure Fos_Init (Comport: Byte);πbeginπ Fos_Clear_Regs;π With Regs Doπ beginπ AH := 4;π DX := (ComPort-1);π Intr ($14, Regs);π if AX <> $1954 thenπ beginπ Writeln;π Writeln (' Fossil driver is not loaded.');π halt (1);π end;π end;πend;ππProcedure Fos_Close (Comport: Byte);πbeginπ Fos_Clear_Regs;π Fos_Dtr(Comport,False);ππ With Regs Doπ beginπ AH := 5;π DX := (ComPort-1);π Intr ($14, Regs);π end;πend;πππProcedure Fos_Parms (ComPort: Byte; Baud: Integer; DataBits: Byte;π Parity: Char; StopBit: Byte);πVarπ Code: Integer;πbeginπ Code:=0;π Fos_Clear_Regs;π Case Baud ofπ 0 : Exit;π 100 : code:=code+000+00+00;π 150 : code:=code+000+00+32;π 300 : code:=code+000+64+00;π 600 : code:=code+000+64+32;π 1200: code:=code+128+00+00;π 2400: code:=code+128+00+32;π 4800: code:=code+128+64+00;π 9600: code:=code+128+64+32;π end;ππ Case DataBits ofπ 5: code:=code+0+0;π 6: code:=code+0+1;π 7: code:=code+2+0;π 8: code:=code+2+1;π end;ππ Case Parity ofπ 'N','n': code:=code+00+0;π 'O','o': code:=code+00+8;π 'E','e': code:=code+16+8;π end;ππ Case StopBit ofπ 1: code := code + 0;π 2: code := code + 4;π end;ππ With Regs doπ beginπ AH := 0;π AL := Code;π DX := (ComPort-1);π Intr ($14, Regs);π end;πend;ππProcedure Fos_Dtr (Comport: Byte; State: Boolean);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 6;π DX := (ComPort-1);π Case State ofπ True : AL := 1;π False: AL := 0;π end;π Intr ($14, Regs);π end;πend;πππFunction Fos_CD (Comport: Byte) : Boolean;πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 3;π DX := (ComPort-1);π Intr ($14, Regs);π Fos_Cd := ((AL and 128) = 128);π end;πend;πππProcedure Fos_Flow (Comport: Byte; State: Boolean);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 15;π DX := ComPort-1;π Case State ofπ True: AL := 255;π False: AL := 0;π end;π Intr ($14, Regs);π end;πend;ππProcedure Fos_Kill_Out (Comport: Byte);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 9;π DX := ComPort-1;π Intr ($14, Regs);π end;πend;πππProcedure Fos_Kill_In (Comport: Byte);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 10;π DX := ComPort-1;π Intr ($14, Regs);π end;πend;ππProcedure Fos_Flush (Comport: Byte);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 8;π DX := ComPort-1;π Intr ($14, Regs);π end;πend;ππFunction Fos_Avail (Comport: Byte) : Boolean;πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 3;π DX := ComPort-1;π Intr ($14, Regs);π Fos_Avail:= ((AH and 1) = 1);π end;πend;ππFunction Fos_OkToSend (Comport: Byte) : Boolean;πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 3;π DX := ComPort-1;π Intr ($14, Regs);π Fos_OkToSend := ((AH and 32) = 32);π end;πend;πππFunction Fos_Empty (Comport: Byte) : Boolean;πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 3;π DX := ComPort-1;π Intr ($14, Regs);π Fos_Empty := ((AH and 64) = 64);π end;πend;ππProcedure Fos_Write (Comport: Byte; Character: Char);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 1;π DX := ComPort-1;π AL := ORD (Character);π Intr ($14, Regs);π end;πend;πππProcedure Fos_String (Comport: Byte; OutString: String);πVarπ Pos: Byte;πbeginπ For Pos := 1 to Length(OutString) doπ beginπ Fos_Write(Comport,OutString[Pos]);π end;πOutString:='';πend;πππProcedure Fos_StringCRLF (Comport: Byte; OutString: String);πVarπ Pos: Byte;πbeginπ For Pos := 1 to Length(OutString) doπ Fos_Write(ComPort,OutString[Pos]);π Fos_Write(ComPort,Char(13));π Fos_Write(ComPort,Char(10));π OutString:='';πend;ππProcedure Fos_Bios (Character: Char);π beginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 21;π AL := ORD (Character);π Intr ($14, Regs);π end;πend;πππProcedure Fos_Ansi (Character: Char);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 2;π DL := ORD (Character);π Intr ($21, Regs);π end;πend;πππProcedure Fos_WatchDog (Comport: Byte; State: Boolean);πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 20;π DX := ComPort-1;π Case State ofπ True : AL := 1;π False : AL := 0;π end;π Intr ($14, Regs);π end;πend;πππFunction Fos_Receive (Comport: Byte) : Char;πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 2;π DX := ComPort-1;π Intr ($14, Regs);π Fos_Receive := Chr(AL);π end;πend;πππFunction Fos_Hangup (Comport: Byte) : Boolean;πVarπ Tcount : Integer;πbeginπ Fos_Dtr(Comport,False);π Delay (600);π Fos_Dtr(Comport,True);π if FOS_CD (ComPort)=True thenπ beginπ Tcount:=1;π Repeatπ Fos_String (Comport,'+++');π Delay (3000);π Fos_StringCRLF (Comport,'ATH0');π Delay(3000);π if Fos_CD (ComPort)=False thenπ tcount:=3;π Tcount:=Tcount+1;π Until Tcount=4;π end;ππ if Fos_Cd (ComPort)=True thenπ Fos_Hangup:=Falseπ elseπ Fos_Hangup:=True;πend;πππProcedure Fos_Reboot;πbeginπ Fos_Clear_Regs;π With Regs doπ beginπ AH := 23;π AL := 1;π Intr ($14, Regs);π end;πend;ππFunction Fos_CheckModem (Comport: Byte) : Boolean;πVarπ Ch : Char;π Result : String[10];π I,Z : Integer;ππbeginπ Fos_CheckModem:=False;π Result:='';π For Z:=1 to 3 doπ beginπ Delay(500);π Fos_Write (Comport,Char(13));π Delay(1000);π Fos_StringCRLF (Comport,'AT');π Delay(1000);π Repeatπ if Fos_Avail (Comport) thenπ beginπ Ch:=Fos_Receive(Comport);π Result:=Result+Ch;π end;π Until Fos_Avail(1)=False;π For I:=1 to Length(Result) doπ beginπ if Copy(Result,I,2)='OK' thenπ beginπ Fos_CheckModem:=True;π Exit;π end;π end;π end;πend;πππFunction Fos_AtCmd (Comport: Byte; Command: String) : Boolean;πVarπ Ch : Char;π Result : String[10];π I,Z : Integer;πbeginπ Fos_AtCmd:=False;π Result:='';π For Z:=1 to 3 doπ beginπ Delay(500);π Fos_Write (Comport,Char(13));π Delay(1000);π Fos_StringCRLF (Comport,Command);π Delay(1000);π Repeatπ if Fos_Avail (Comport) thenπ beginπ Ch:=Fos_Receive(Comport);π Result:=Result+Ch;π end;π Until Fos_Avail(1)=False;π For I:=1 to Length(Result) doπ beginπ if Copy(Result,I,2)='OK' thenπ beginπ Fos_AtCmd:=True;π Exit;π end;π end;π end;πend;ππend.ππ 24 08-27-9321:25ALL STEVE GABRILOWIZ Another Fossil Unit IMPORT 95 ╣JΣà {πSTEVE GABRILOWITZππ> I was wondering if anyone had any routines they could send me or tellπ> me where to find some routines that show you have to use theπ> fossil I have a file on my BBS called TPIO_100.ZIP,π}ππUnit IO;πππ { FOSSIL communications I/O routines }π { Turbo Pascal Version by Tony Hsieh }ππ {}{}{}{ Copyright (c) 1989 by Tony Hsieh, All Rights Reserved. }{}{}{}πππ{ The following routines are basic input/output routines, using a }π{ fossil driver. These are NOT all the routines that a fossil }π{ driver can do! These are just a portion of the functions that }π{ fossil drivers can do. However, these are the only ones most }π{ people will need. I highly recommend for those that use this }π{ to download an arced copy of the X00.SYS driver. In the arc }π{ is a file called "FOSSIL.DOC", which is where I derived my }π{ routines from. If there are any routines that you see are not }π{ implemented here, use FOSSIL.DOC to add/make your own! I've }π{ listed enough examples here for you to figure out how to do it }π{ yourself. }π{ This file was written as a unit for Turbo Pascal v4.0. You }π{ should compile it to DISK, and then in your own program type }π{ this right after your program heading (before Vars and Types) }π{ this: "uses IO;" }π{ EXAMPLE: }π{ππProgram Communications;ππuses IO;ππbeginπ InitializeDriver;π Writeln ('Driver is initalized!');π ModemSettings (1200,8,'N',1); Baud := 1200;π DTR (0); Delay (1000); DTR (1);π Writeln ('DTR is now true!');π CloseDriver;π Writeln ('Driver is closed!');πend.ππ}ππ{ Feel free to use these routines in your programs; copy this }π{ file freely, but PLEASE DO NOT MODIFY IT. If you do use }π{ these routines in your program, please give proper credit to }π{ the author. }π{ }π{ Thanks, and enjoy! }π{ }π{ Tony Hsieh }πππππINTERFACEππusesπ DOS;ππ { These are communications routines }π { that utilize a FOSSIL driver. A }π { FOSSIL driver MUST be installed, }π { such as X00.SYS and OPUS!COM... }ππtypeπ String255 = String [255];ππvarπ Port : Integer; { I decided to make 'Port' a global }π { variable to make life easier. }ππ Baud : Word; { Same with Baud }ππ RegistersRecord: Registers; { DOS registers AX, BX, CX, DX, and Flags }πππprocedure BlankRegisters;πprocedure ModemSettings(Baud, DataBits : Integer; Parity : Char;π Stopbits : Integer);πprocedure InitializeDriver;πprocedure CloseDriver;πprocedure ReadKeyAhead (var First, Second : Char);πfunction ReceiveAhead (var Character : CHAR) : Boolean;πfunction Online : boolean;πprocedure DTR(DTRState : Integer);πprocedure Reboot;πprocedure BiosScreenWrite(Character: CHAR);πprocedure WatchDog(INPUT : Boolean);πprocedure WhereCursor(var Row : Integer; var Column : Integer);πprocedure MoveCursor(Row : Integer; Column : Integer);πprocedure KillInputBuffer;πprocedure KillOutputBuffer;πprocedure FlushOutput;πfunction InputAvailable : Boolean;πfunction OutputOkay : Boolean;πprocedure ReceiveCharacter(var Character : CHAR);πprocedure TransmitCharacter(Character : CHAR; var Status : Integer);πprocedure FlowControl(Control : Boolean);πprocedure CharacterOut(Character : CHAR);πprocedure StringOut(Message : String255);πprocedure LineOut(Message : String255);πprocedure CrOut;πππIMPLEMENTATIONππprocedure BlankRegisters;πbeginπ Fillchar(RegistersRecord, SizeOf(RegistersRecord), 0);πend;ππprocedure ModemSettings (Baud, DataBits : Integer; Parity : Char;π StopBits : Integer);π { Do this after initializing }π { the FOSSIL driver and also }π { when somebody logs on }πvarπ GoingOut: Integer;πbeginπ GoingOut := 0;π Case Baud ofπ 0 : Exit;π 100 : GoingOut := GoingOut + 000 + 00 + 00;π 150 : GoingOut := GoingOut + 000 + 00 + 32;π 300 : GoingOut := GoingOut + 000 + 64 + 00;π 600 : GoingOut := GoingOut + 000 + 64 + 32;π 1200: GoingOut := GoingOut + 128 + 00 + 00;π 2400: GoingOut := GoingOut + 128 + 00 + 32;π 4800: GoingOut := GoingOut + 128 + 64 + 00;π 9600: GoingOut := GoingOut + 128 + 64 + 32;π end;π Case DataBits ofπ 5: GoingOut := GoingOut + 0 + 0;π 6: GoingOut := GoingOut + 0 + 1;π 7: GoingOut := GoingOut + 2 + 0;π 8: GoingOut := GoingOut + 2 + 1;π end;π Case Parity ofπ 'N' : GoingOut := GoingOut + 00 + 0;π 'O','o': GoingOut := GoingOut + 00 + 8;π 'n' : GoingOut := GoingOut + 16 + 0;π 'E','e': GoingOut := GoingOut + 16 + 8;π end;π Case StopBits ofπ 1: GoingOut := GoingOut + 0;π 2: GoingOut := GoingOut + 4;π end;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 0;π AL := GoingOut;π DX := (Port);π Intr($14, RegistersRecord);π end;πend;ππprocedure InitializeDriver; { Do this before doing }πbegin { any IO routines!!! }π BlankRegisters;π With RegistersRecord doπ beginπ AH := 4;π DX := (Port);π Intr($14, RegistersRecord);π If AX <> $1954 thenπ beginπ Writeln('* FOSSIL DRIVER NOT RESPONDING! OPERATION HALTED!');π halt(1);π end;π end;πend;ππprocedure CloseDriver; { Run this after all I/O routines are done with }πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 5;π DX := (Port);π Intr($14, RegistersRecord);π end;π BlankRegisters;πend;ππprocedure ReadKeyAhead (var First, Second: Char); { This procedure is via }π { the FOSSIL driver, not }π { DOS! }πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := $0D;π Intr($14,RegistersRecord);π First := chr(lo(AX));π Second := chr(hi(AX));π end;πend;ππfunction ReceiveAhead (var Character: CHAR): Boolean; { Non-destructive }πbeginπ If Baud=0 then exit;π BlankRegisters;π With RegistersRecord doπ beginπ AH := $0C;π DX := Port;π Intr ($14,RegistersRecord);π Character := CHR (AL);π ReceiveAhead := AX <> $FFFF;π end;πend;ππfunction OnLine: Boolean;πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 3;π DX := (Port);π Intr ($14, RegistersRecord);π OnLine := ((AL AND 128) = 128);π end;πend;ππprocedure DTR (DTRState: Integer); { 1=ON, 0=OFF }π { Be sure that the modem dip switches }π { are set properly... when DTR is off }π { it usually drops carrier if online }πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 6;π DX := (Port);π AL := DTRState;π Intr ($14, RegistersRecord);π end;πend;ππprocedure Reboot; { For EXTREME emergencies... Hmmm... }πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 23;π AL := 1;π Intr ($14, RegistersRecord);π end;πend;ππ{ This is ANSI Screen Write via Fossil Driver }π{πprocedure ANSIScreenWrite (Character: CHAR);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 19;π(100 min left), (H)elp, More? AL := ORD (Character);π Intr ($14, RegistersRecord);π end;πend;π}ππ{ This is ANSI Screen Write via DOS! }ππprocedure ANSIScreenWrite (Character: CHAR);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 2;π DL := ORD (Character);π Intr ($21, RegistersRecord);π end;πend;πππprocedure BIOSScreenWrite (Character: CHAR); { Through the FOSSIL driver }πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 21;π AL := ORD (Character);π Intr ($14, RegistersRecord);π end;πend;ππprocedure WatchDog (INPUT: Boolean);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 20;π DX := Port;π Case INPUT ofπ TRUE: AL := 1;π FALSE: AL := 0;π end;π Intr ($14, RegistersRecord);π end;πend;ππprocedure WhereCursor (var Row: Integer; var Column: Integer);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 18;π Intr ($14, RegistersRecord);π Row := DH;π Column := DL;π end;πend;ππprocedure MoveCursor (Row: Integer; Column: Integer);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 17;π DH := Row;π DL := Column;π Intr ($14, RegistersRecord);π end;πend;ππprocedure KillInputBuffer; { Kills all remaining input that has not been }π { read in yet }πbeginπ If Baud=0 then exit;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 10;π DX := Port;π Intr ($14, RegistersRecord);π end;πend;ππprocedure KillOutputBuffer; { Kills all pending output that has not been }π { send yet }πbeginπ If Baud=0 then exit;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 9;π DX := Port;π Intr ($14, RegistersRecord);π end;πend;ππprocedure FlushOutput; { Flushes the output buffer }πbeginπ If Baud=0 then exit;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 8;π DX := Port;π Intr ($14, RegistersRecord);π end;πend;ππfunction InputAvailable: Boolean; { Returns true if there's input }π { from the modem. }πbeginπ InputAvailable := False;π If Baud=0 then exit;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 3;π DX := Port;π Intr ($14, RegistersRecord);π InputAvailable := ((AH AND 1) = 1);π end;πend;ππfunction OutputOkay: Boolean; { Returns true if output buffer isn't full }πbeginπ OutputOkay := True;π If Baud=0 then exit;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 3;π DX := Port;π Intr ($14, RegistersRecord);π OutputOkay := ((AH AND 32) = 32);π end;πend;ππprocedure ReceiveCharacter (var Character: CHAR); { Takes a character }π { out of the input }π { buffer }πbeginπ Character := #0;π BlankRegisters;π With RegistersRecord doπ beginπ AH := 2;π DX := Port;π Intr ($14, RegistersRecord);π Character := CHR (AL);π end;πend;ππprocedure TransmitCharacter (Character: CHAR; var Status: Integer);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 1;π DX := Port;π AL := ORD (Character);π Intr ($14, RegistersRecord);π Status := AX; { Refer to FOSSIL.DOC about the STATUS var }π end;πend;ππprocedure FlowControl (Control: Boolean);πbeginπ BlankRegisters;π With RegistersRecord doπ beginπ AH := 15;π DX := Port;π Case Control ofπ TRUE: AL := 255;π FALSE: AL := 0;π end;π Intr ($14, RegistersRecord);π end;πend;ππprocedure CharacterOut (Character: CHAR);πvarπ Status: INTEGER;πbeginπ { If SNOOP is on then }π ANSIScreenWrite (Character);π TransmitCharacter (Character, Status);πend;ππprocedure StringOut (Message: String255);πvarπ CharPos: Byte;πbeginπ CharPos := 0;π If Length(Message) <> 0 thenπ beginπ Repeatπ If NOT Online then exit;π CharPos := CharPos + 1;π CharacterOut (Message [CharPos]);π Until CharPos = Length (Message);π end;πend;ππprocedure LineOut (Message: String255);πbeginπ StringOut (Message);π CharacterOut (#13);π CharacterOut (#10);πend;ππprocedure CrOut; { Outputs a carriage return and a line feed }πbeginπ CharacterOut (#13);π CharacterOut (#10);πend;ππend.π 25 08-27-9321:37ALL GINA DAVIS A Simple Int14 Unit IMPORT 14 ╣J"▄ {πGINA DAVISππI have used routines to read/write the comm ports and read Status usingπthe Port instruction, but mostly I have used BIOS calls (Int $14). Whatπyou need is a technical reference book spelling out the Registers andπthe use of each bit. (I have a book called "DOS Programmers Reference")πI have source code which accesses a modem on Com1 or Com2 to dial phoneπnumbers as part of my name & address database / dialer prog (Shareware).ππHere's an example of calling INT 14 to set up the serial port:-π}ππFUNCTION Init_Port(serialport, params : word) : word;πBEGINπ regs.AX := params;π regs.DX := port;π regs.AH := 0;π intr($14, regs);πEND;ππ{π The "serialport" is 0 for Com1 or 1 for Com2.π "params" determines baud, parity, stop bits, etc.π $43 for 300, $A3 gives 2400, $83 gives 1200,8,N,1 (p468 DOS Prog Ref)π (baudbits SHL 5) OR OtherBits - 110,150,300,600,1200,2400,4800,9600ππ The function returns the Status, ie. whether the operation was successful.π And an example of using "Port" to directly access the a port register toπ toggle the DTR bit to hangup the modem:-π}ππPROCEDURE Hang_Up_Modem(serialport : word);πVARπ portaddress : word;π dummychar : char;πBEGINπ IF serialport = 0 THENπ portaddress := $3FCπ ELSEπ portaddress := $2FC;ππ port[portaddress] := port[portaddress] xor $01;π DELAY(10);π port[portaddress] := port[portaddress] xor $01;π DELAY(10);π port[portaddress] := port[portaddress] AND $FE;ππ REPEATπ dummychar := read_modem(serialport)π UNTIL regs.AH <> 0;πEND; { Hang_Up_Modem }ππ 26 08-27-9321:51ALL HERB BROWN Detect Phone Ringing IMPORT 10 ╣J≤ {πHERB BROWNππAnybody using any of the public domain fossil units? You are? Great! Here isπa procedure to add ring detection to them.ππFos_ringing works by "peeking" into the buffers for a carriage return. Afterπa ring is detected by your modem, the CR will be the last character in yourπbuffer. You could re-write the following to retrieve a connect string, ifπyou wanted. Since the fossil takes care of the dirty bussiness, at the momentπI wasn't worried about it.ππOnce you establish the phone rang, simply send an ATA to the modem and delayπfor about 11-15 seconds for connection. (maybe more for higher speed modems.)ππWhat really has me puzzled, though, of all the PD code for fossils, nothingπlike this was ever included.π}ππFunction Fos_Ringing(ComPort : Byte) : Boolean;πvarπ CC : Char;πbeginπ Fos_Ringing := False;π Regs.Ah := $0C;π Regs.Dx := ComPort - 1;π Intr($14, Regs);ππ if regs.ax = $FFFF thenπ Fos_ringing := falseπ elseπ beginπ cc := chr(regs.al);π if cc = #13 thenπ Fos_ringing := true;π end;πend;ππ 27 08-27-9321:52ALL MIKE MOSSERI Another Ring Detect IMPORT 11 ╣Jï┴ {πMIKE MOSSERIππ> Does anyone have any bbs routines that they recommend. I'd prefer ifπ>it came With source but one that doesn't is good. Mostly I want theπ>modem routines. Also does anyone have a routine to answer the phone andπ>tell the baud rate of connection? I working on a bbs Program (mostlyπ>just For myself, small and quick) and Im doing it from scratch. Im haveπ>some communication routines but Im looking For others made For bbs's.π}πππUsesπ Dos, Crt;ππVarπ REGS : Registers;ππFunction CheckRing(Comport : Byte) : Boolean;πbeginπ fill(Regs, SizeOf(Regs), 0); {Reset All Registers}π Regs.AH := 3;π Regs.DX := Comport - 1;π Intr($14, Regs);π CheckRing:= ((Regs.Al and $40) = $40);πend;ππ{π The Function comes back True only when a ring is currently happening soπyou can:π}ππbeginπ Repeatπ Until CheckRing(2); {Or Whatever comport}π Delay(1000); {Give it a sec}π Writeln_Fossil('ATA'); {Or Whatever you use to Interface w/ the fossil}π While not CarrierDetect do Delay(250); {Suffecient Time}ππ{π Well that should answer the phone, now if you want to check the baudπyou can read a line from the modem or something.π}π 28 09-26-9308:45ALL GARY GORDON Small,Good ASYNC routinesIMPORT 65 ╣Js" {$B-} { Short circuit boolean ON }π{$I-} { I/O checking OFF }π{$R-} { Range checking OFF }π{$S-} { Stack checking OFF }π{$V-} { Var-str checking OFF}ππUNIT ASYNC2;π {PD async unit debugged and modified for doorgame use by Joel Bergen}π {added com3 & com4 support and xon/xoff handshaking }π {various bug fixes by Gary Gordon & Joel Bergen Jan 1990}π {Last revised: 1/14/90}π {still needs check for existance of comm port in Async_Open routine}ππINTERFACEππUSES DOS, CRT;ππVARπ Async_CheckCTS : BOOLEAN;ππPROCEDURE Async_Init;π { initialize variables, call first to initialize }ππPROCEDURE Async_Close;π { reset the interrupt system when UART interrupts no longer needed }π { Turn off the COM port interrupts. }π { **MUST** BE CALLED BEFORE EXITING YOUR PROGRAM; otherwise you }π { will see some really strange errors and have to re-boot. }ππFUNCTION Async_Open(ComPort,BaudRate : WORD) : BOOLEAN;π { open a communications port at 8/n/1 with supplied port & baud }π { Sets up interrupt vector, initialies the COM port for }π { processing, sets pointers to the buffer. Returns FALSE if COM }π { port not installed. }ππFUNCTION Async_Buffer_Check : BOOLEAN;π { see if a character has been received }π { If a character is available, returns TRUE }π { Otherwise, returns FALSE }ππFUNCTION Async_Read : CHAR;π { read a character, assuming it is ready}ππPROCEDURE Async_Send(C : CHAR);π { transmit a character }ππPROCEDURE Async_Hangup;π { drop carrier by dropping DTR}ππFUNCTION Async_CarrierDetect : BOOLEAN;π { true if carrier detected }ππ{----------------------------------------------------------------------------}ππIMPLEMENTATIONππCONSTπ I8088_IMR = $21; { port address of the Interrupt Mask Register }π AsyncBasePort : ARRAY[1..4] OF WORD = ($03F8,$02F8,$03E8,$02E8);π AsyncIRQ : ARRAY[1..4] OF WORD = (4,3,4,3);π Async_Buffer_Max = 1024; { size of input buffer }π Ier = 1;π Lcr = 3;π Mcr = 4;π Lsr = 5;π Msr = 6;ππVARπ Async_OriginalVector : POINTER;π Async_OriginalLcr : INTEGER;π Async_OriginalImr : INTEGER;π Async_OriginalIer : INTEGER;ππ Async_Buffer : ARRAY[0..Async_Buffer_Max] OF CHAR;ππ Async_Open_Flag : BOOLEAN; { true if Open but no Close }π Async_Pause : BOOLEAN; { true if paused (Xoff received) }π Async_Port : INTEGER; { current Open port number (1..4) }π Async_Base : INTEGER; { base for current open port }π Async_Irq : INTEGER; { irq for current open port }ππ Async_Buffer_Overflow: BOOLEAN; { True if buffer overflow has happened }π Async_Buffer_Used : WORD; { number of characters in input buffer }ππ { Async_Buffer is empty if Head = Tail }π Async_Buffer_Head : WORD; { Locn in Async_Buffer to put next char }π Async_Buffer_Tail : WORD; { Locn in Async_Buffer to get next char }ππPROCEDURE DisableInterrupts; INLINE($FA {cli} ); {MACROS}πPROCEDURE EnableInterrupts; INLINE($FB {sti} );ππPROCEDURE Async_Isr; INTERRUPT;π{ Interrupt Service Routineπ Invoked when the UART has received a byte of data from theπ communication line }πCONSTπ Xon = #17; {^q resume}π Xoff = #19; {^s pause}πVARπ c : CHAR;πBEGINπ EnableInterrupts;π IF Async_Buffer_Used < Async_Buffer_Max THEN BEGINπ c := CHR(PORT[Async_Base]);π CASE c OFπ Xoff : Async_Pause:=TRUE;π Xon : Async_Pause:=FALSE;π ELSE BEGINπ Async_Pause:=FALSE;π Async_Buffer[Async_Buffer_Head] := c;π IF Async_Buffer_Head < Async_Buffer_Max THENπ INC(Async_Buffer_Head)π ELSEπ Async_Buffer_Head := 0;π INC(Async_Buffer_Used);π END;π END;π END ELSE Async_Buffer_Overflow := TRUE;π DisableInterrupts;π PORT[$20] := $20;πEND; { Async_Isr }ππPROCEDURE Async_Init;π{ initialize variables }πBEGINπ Async_Open_Flag := FALSE;π Async_Buffer_Head := 0;π Async_Buffer_Tail := 0;π Async_Buffer_Overflow := FALSE;π Async_Buffer_Used := 0;π Async_Pause := FALSE;π Async_CheckCTS := TRUE;πEND; { Async_Init }ππPROCEDURE Async_Close;π{ reset the interrupt system when UART interrupts no longer needed }πVARπ i, m : INTEGER;πBEGINπ IF Async_Open_Flag THEN BEGINπ DisableInterrupts; { disable IRQ on 8259 }π PORT[Async_Base + Ier] := Async_OriginalIer;π PORT[Async_Base+Lcr] := Async_OriginalLcr;π PORT[I8088_IMR] := Async_OriginalImr;π EnableInterrupts;π SETINTVEC(Async_Irq + 8,Async_OriginalVector);π Async_Open_Flag := FALSE { flag port as closed }π ENDπEND; { Async_Close }ππFUNCTION Async_Open(ComPort,BaudRate : WORD) : BOOLEAN;πVARπ i, m : INTEGER;π b : BYTE;πBEGINπ IF Async_Open_Flag THEN Async_Close;π Async_Port := ComPort;π Async_Base := AsyncBasePort[Async_Port];π Async_Irq := AsyncIRQ[Async_Port];π { set comm parameters }π Async_OriginalLcr := PORT[Async_Base+Lcr];ππ PORT[Async_Base+Lcr] := $03; {set 8/n/1. This shouldn't be hardcoded}π { set ISR vector }π GETINTVEC(Async_Irq+8, Async_OriginalVector);π SETINTVEC(Async_Irq+8, @Async_Isr);π { read the RBR and reset any possible pending error conditions }π { first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }π DisableInterrupts;π PORT[Async_Base+Lcr] := PORT[Async_Base+Lcr] AND $7F;π { read the Line Status Register to reset any errors it indicates }π i := PORT[Async_Base+Lsr];π { read the Receiver Buffer Register in case it contains a character }π i := PORT[Async_Base];π { enable the irq on the 8259 controller }π i := PORT[I8088_IMR]; { get the interrupt mask register }ππ Async_OriginalImr := i;ππ m := (1 shl Async_Irq) XOR $00FF;π PORT[I8088_IMR] := i AND m;π { enable the data ready interrupt on the 8250 }ππ Async_OriginalIer := PORT[Async_Base + Ier];ππ Port[Async_Base + Ier] := $01; { enable data ready interrupt }π { enable OUT2 on 8250 }π i := PORT[Async_Base + Mcr];π PORT[Async_Base + Mcr] := i OR $08;π EnableInterrupts;π { Set baudrate}π b := PORT[Async_Base+Lcr] OR 128;π PORT[Async_Base+Lcr]:= b;π PORT[Async_Base ] := LO(TRUNC(115200.0/BaudRate));π PORT[Async_Base+1] := HI(TRUNC(115200.0/BaudRate));π PORT[Async_Base+Lcr]:= b AND 127;π { set flags }π Async_Open_Flag := TRUE;π Async_Open := TRUE;πEND; { Async_Open }ππFUNCTION Async_Buffer_Check : BOOLEAN;π{ return true if character ready to receive }πBEGINπ Async_Buffer_Check := (Async_Buffer_Used <> 0);πEND; { Async_Buffer_Check }ππFUNCTION Async_Read : CHAR;π{ return char, use Async_Buffer_Check first! }πBEGINπ Async_Read := Async_Buffer[Async_Buffer_Tail];π INC(Async_Buffer_Tail);π IF Async_Buffer_Tail > Async_Buffer_Max THENπ Async_Buffer_Tail := 0;π DEC(Async_Buffer_Used);πEND; { Async_Buffer_Check }ππPROCEDURE Async_Send(c : CHAR);π{ transmit a character }πBEGINπ PORT[Async_Base + Mcr] := $0B; {turn on OUT2, DTR, and RTS}π IF Async_CheckCTS THENπ WHILE (Port[Async_Base + Msr] AND $10) = 0 DO; {wait for CTS}π WHILE (Port[Async_Base + Lsr] AND $20) = 0 DO; {wait for Tx Holding Reg Empty}π WHILE Async_Pause AND Async_CarrierDetect DO; {wait for Xon}π DisableInterrupts;π PORT[Async_Base] := ORD(c); {send the character}π EnableInterrupts;πEND; { Async_Send }ππPROCEDURE Async_Hangup;πBEGINπ PORT[Async_Base+Mcr] := $00; {dtr off}π DELAY(1000); {wait 1 second}π PORT[Async_Base+Mcr] := $03; {dtr on}πEND;ππFUNCTION Async_CarrierDetect : BOOLEAN;π{true if carrier}πVARπ b : BOOLEAN;π w : WORD;πBEGINπ w:=0; b:=TRUE;π WHILE (w<500) AND b DO BEGIN {make sure carrier stays down}π INC(w); {and is not just a fluke }π b:=(PORT[Async_Base+Msr] AND 128) <> 128; {true = no carrier};π END;π Async_CarrierDetect := NOT b;πEND;ππBEGINπ Async_Init;πEND. { ASYNC UNIT }π 29 10-28-9311:40ALL DAVID CRUGER UART Detection IMPORT 64 ╣Jà {-------------------------------------------------------------------------π ! !π ! UARD.PAS : Uart Detection Program Ver 1.0 !π ! !π ! Created : 09-23-93 Changed: 09-23-93 !π ! !π ! Converted To Turbo Pascal 6.0 By: David D. Cruger !π ! !π ! Original Program By: National Semiconductor Corporation !π ! NS1655.ZIP Microcomputer Systems Division !π ! Microcontroller Applications Group !π ! Written By: Louis Shay / 01/11/89 !π ! Originaly Written in some form of 'C'. !π ! This program only does the 'detection'. !π ! The original program ran some tests on !π ! the Uarts. !π ! !π ! SAVE/RESTORE Uart Registers Routines from Form Message #195739 !π ! by Michael Day (TeamB) !π ! !π ! *NOTE* This program is just an example of how to detect Uarts and !π ! is not intended to be a stand alone program. I here by !π ! release this program to the public domain. Use at your own !π ! risk. !π ! !π ! 0: No Uart at Port Address !π ! 1: INS8250, INS8250-B !π ! 2: INS8250A, INS82C50A, NS16450, NS16C450 !π ! 3: NS16550A !π ! 4: NS16C552 !π ! !π !------------------------------------------------------------------------}ππProgram UartD;ππ {π A = Align Dataπ B = Boolean Shortπ D = Debug Onπ E = Emulate 80287π F = Far Callsπ G = Generate 286 Codeπ L = Local Symbol Informationπ N = Numeric Processing Switchπ O = Overlayπ R = Range Checking Onπ S = Stack-Overflowπ V = Var-String Checkingπ }ππ{$a+,b-,d-,e-,f-,g-,l-,n-,o-,r-,s-,v-} {}π{$M 2500,0,0}ππUses Dos;ππType Uart_Registers=Array[0..9] OF Byte; { Uart Registers }ππVar URegs: Uart_Registers; { Uart Register Array }π PA : Word; { Port Address Com1=$3F8 Com2=$2F8.. }ππ RBR,THR,IER,IIR,FCR,LCR,MCR,LSR,MSR,SCR,DLL,DLM,AFR: Word;ππ{-------- Save Uart Registers --------}πProcedure Save_Uart_Registers(BaseAdd: Word; Var URegs: Uart_Registers);πVar I: Byte;πBeginπ ASM CLI; END;π For I:=1 to 6 Do URegs[I]:=Port[BaseAdd+I];π Port[BaseAdd+3]:=Port[BaseAdd+3] or $80;π URegs[7]:=Port[BaseAdd+0];π URegs[8]:=Port[BaseAdd+1];π Port[BaseAdd+3]:=Port[BaseAdd+3] and $7F;π ASM STI; END;πEnd; { End Procedure }ππ{------ Restore Uart Registers --------}πProcedure Restore_Uart_Registers(BaseAdd: Word; URegs: Uart_Registers);πVar I: Byte;πBeginπ ASM CLI; END;π Port[BaseAdd+3]:=Port[BaseAdd+3] or $80;π Port[BaseAdd+0]:=URegs[7];π Port[BaseAdd+1]:=URegs[8];π Port[BaseAdd+3]:=Port[BaseAdd+3] and $7F;π For I:=1 to 6 Do Port[BaseAdd+I]:=URegs[I];π ASM STI; END;πEnd; { End Procedure }ππProcedure Return_Code(C: Byte);πBeginππ Case C ofπ 0:Writeln('No Uart at Port Address');π 1:Writeln('INS8250, INS8250-B');π 2:Writeln('INS8250A, INS82C50A, NS16450, NS16C450');π 3:Writeln('NS16550A');π 4:Writeln('NS16C552');π End;ππ Restore_Uart_Registers(PA,URegs);ππ Halt(C); { Halt with Errorlevel of Uart }ππEnd; { End Procedure }ππProcedure Set_Uart_Register_Values(PA: Word);πBeginππRBR:=PA+0; { Receive Buffer Registers (R ) (DLAB=0) }πTHR:=PA+0; { Transmitter Holding Register ( W) (DLAB=0) }πIER:=PA+1; { Interrupt Enable Register (R/W) (DLAB=0) }πIIR:=PA+2; { Interrupt Ident. Register (R ) }πFCR:=PA+2; { FIFO Control Register ( W) }πLCR:=PA+3; { Line Control Register (R/W) }πMCR:=PA+4; { MODEM Control Register (R/W) }πLSR:=PA+5; { Line Status Register (R ) }πMSR:=PA+6; { MODEM Status Register (R/W) }πSCR:=PA+7; { Scratch Register (R/W) }πDLL:=PA+0; { Divisor Latch (LSB) (R/W) (DLAB=1) }πDLM:=PA+1; { Divisor Latch (MSB) (R/W) (DLAB=1) }πAFR:=PA+2; { Alternate Function Register (R/W) }ππEnd; { End Procedure }ππBegin { Main Section of Program }ππPA:=$3F8; { Com1/ This can be changed to any port address you want }πWrite('Com1: $3F8 : Uart:=');ππSave_Uart_Registers(PA,URegs); { Saves State of Current Uart Registers }πSet_Uart_Register_Values(PA); { Return_Code() Restores Uart Registers }ππPort[LCR]:=$AA; { Test LCR Registers }πIf $AA<>Port[LCR] Then Return_Code(0);ππPort[DLM]:=$55; { Test DLM Present 8-bits }πIf $55<>Port[DLM] Then Return_Code(0);ππPort[LCR]:=$55; { LCR/ DLAB=0 }πIf $55<>Port[LCR] Then Return_Code(0);ππPort[IER]:=$55; { Test IER Present 4-bits }πIf $05<>Port[IER] Then Return_Code(0);ππPort[FCR]:=$0; { FIFO's Off, If Present }πPort[IER]:=$0; { Interrupts Off, IIR Should be 01 }πIf $1<>Port[IIR] Then Return_Code(0);ππ{----- Test Modem Control Register Address. Should be 5-bits Wide -----}πPort[MCR]:=$F5; { 8-bit Write }πIf $15<>Port[MCR] Then Return_Code(0);ππ{------ Test MCR/MSR Loopback Functions ------}ππPort[MCR]:=$10; { Set Loop Mode }πPort[MSR]:=$0; { Clear out Delta Bits }πIf ($F0 and Port[MSR])<>0 Then Return_Code(0); { Check State Bits }ππPort[MCR]:=$1F; { Toggle Modem Control Lines }πIf ($F0 and Port[MSR])<>$F0 Then Return_Code(0); { Check State Bits }ππPort[MCR]:=$03; { Exit Loop Mode, DTR, RTS Active }ππ{---- Port Id Successful at this point. determine port type ----}ππPort[SCR]:=$55; { Is There a Scratch Register? }πIf $55<>Port[SCR] Then Return_Code(1); { No SCR, Type = INS8250 }ππPort[FCR]:=$CF; { Enable FIFO's, If Present }πIf ($C0 and Port[IIR])<>$C0 Then Return_Code(2); { Check FIFO ID bits }πPort[FCR]:=$0; { Turn Off FIFO's }ππPort[LCR]:=$80; { Set DLAB }πPort[AFR]:=$07; { Write to AFR }πIf $07<>Port[AFR] Then { Read AFR }π Beginπ Port[LCR]:=$0; { Reset DLAB }π Return_Code(3); { If Not Type=NS16550A }π End;ππPort[AFR]:=$0; { Clear AFR }πPort[LCR]:=$0; { Reset DLAB }πReturn_Code(4);ππEnd.π 30 11-02-9305:56ALL CHRISTIAN PHILIPPS Very GOOD Async package IMPORT 98 ╣J╧ {πFRANCK DUMONTππ------------------------------------------ ASM ------------------------------ππ;//////////////////////////////////////////////////////////////////////////π;/// ///π;/// Turbo-Pascal V24-Interrupt-Support V2.00 ///π;/// ///π;/// (c) Christian Philipps, Moers ///π;/// June 1988 / West-Germany ///π;/// ///π;/// Turbo Pascal 4.0 or above required ///π;/// ///π;//////////////////////////////////////////////////////////////////////////ππ; This module is hereby donated to the public domain.ππ;─────────────────────────────────────────────────────────────────────────π; Datensegmentπ;─────────────────────────────────────────────────────────────────────────ππDATA SEGMENT BYTE PUBLICππ ; Turbo-Pascal Variableπ EXTRN V24HP : WORDπ EXTRN V24TP : WORDπ EXTRN V24BuffEnd : WORDπ EXTRN V24Buff : BYTEπ EXTRN ComBase : WORDππDATA ENDSππ;─────────────────────────────────────────────────────────────────────────π; Codesegmentπ;─────────────────────────────────────────────────────────────────────────ππCODE SEGMENT BYTE PUBLICππ ASSUME CS:CODE, DS:DATAππ PUBLIC V24Intππ;─────────────────────────────────────────────────────────────────────────ππ;CS-relative Datenππ_Turbo_DS DW DATA ; Turbo data segmentπ ; (inserted by linkage editor)ππ;─────────────────────────────────────────────────────────────────────────π; Codebereichπ;─────────────────────────────────────────────────────────────────────────π;PROCEDURE V24Int; interrupt;π; this routine is executed whenever a character arrivesππV24Int PROC FAR ; Interrupt-RoutineπππV24Int ENDPππ push ds ; save registersπ push axπ push bxπ push dxπ mov ds,CS:_Turbo_DS ; set Turbo DSππ mov bx,V24TP ; ds:bx -> next free slotπ mov dx,ComBase ; dx = port base-addressπ in al,dx ; RBR -> alπ mov byte ptr [bx],al ; move byte into bufferπ inc bx ; pointer to next slotπ cmp bx,V24BuffEnd ; past the end of the buffer?π jle L1 ; noπ mov bx,OFFSET V24Buff ; yes, so wrap aroundππL1: cmp bx,V24HP ; TP=HP --> overflow!π jz L2 ; yes, ignore characterπ mov V24TP,bx ; no, save new tail pointerππL2: mov al,20H ; EOI -> 8259π out 20H,alπ pop dx ; restore registersπ pop bxπ pop axπ pop dsπ iretππCODE ENDSππENDπ}π(*////////////////////////////////////////////////////////////////////////////π/// ///π/// T U R B O - P A S C A L V24-Interrupt-Support V2.00 ///π/// (c) Copyright June 1988 by C.Philipps ///π/// ///π/// (Turbo Pascal V4.0 or higher required) ///π/// ///π//////////////////////////////////////////////////////////////////////////////π/// ///π/// Low-level interrupt-handling for the serial ports. Speeds ///π/// up to 115200 bps are supportet, one port at a time. ///π/// Parts of the basics were taken from Mike Halliday's pop- ///π/// ular ASYNC-package (Turbo Pascal 3.0, PD). ///π/// ///π/// This module is hereby donated to the public domain. ///π/// ///π/// Christian Philipps ///π/// Düsseldorfer Str. 316 ///π/// 4130 Moers 1 ///π/// West-Germany ///π/// ///π/// Last modified: 07/89 ///π/// ///π////////////////////////////////////////////////////////////////////////////*)ππ{$R-,S-,I-,D-,F-,V-,B-,N-,L- }ππUNIT V24;ππINTERFACEππUSESπ DOS;ππTYPEπ ComType = (com1, com2, com3, com4, com5, com6);π BaudType = (b110, b150, b300, b600, b1200, b2400, b4800,π b9600, b19200, b38400, b57600, b115200);π ParityType = (Space, Odd, Mark, Even, None);π DataBitsType = (d5, d6, d7, d8);π StopBitsType = (s1, s2);ππCONSTπ V24Timeout : BOOLEAN = FALSE; {SendByte-Timeout}π IntMasks : ARRAY [Com1..Com6] OF WORD = ($EF,$F7,$EF,$F7,$EF,$F7);π IntVect : ARRAY [Com1..Com6] OF BYTE = ($0C,$0B,$0C,$0B,$0C,$0B);ππVARπ V24TP : WORD; {Buffer Tail-Pointer Im Interface-Teil, da zurπ Ereignis-steuerung im Multi-Tasking benötigt.}π ComBaseAdr : ARRAY [Com1..Com6] OF WORD;ππFUNCTION V24DataAvail : BOOLEAN;πFUNCTION V24GetByte : BYTE;πPROCEDURE InitCom(ComPort : ComType; Baudrate : BaudType; Parity : ParityType;π Bits : DataBitsType; Stop : StopBitsType);πPROCEDURE DisableCom;πPROCEDURE SendByte(Data : BYTE);πππIMPLEMENTATIONππCONSTπ Regs : Registers =π (AX : 0; BX : 0; CX : 0; DX : 0; BP : 0;π SI : 0; DI : 0; DS : 0; ES : 0; FLAGS : 0);π RBR = $00; {xF8 Receive Buffer Register }π THR = $00; {xF8 Transmitter Holding Register }π IER = $01; {xF9 Interrupt Enable Register }π IIR = $02; {xFA Interrupt Identification Register }π LCR = $03; {xFB Line Control Register }π MCR = $04; {xFC Modem Control Register }π LSR = $05; {xFD Line Status Register }π MSR = $06; {xFE Modem Status Register }π {--- if LCR Bit 7 = 1 --- }π DLL = $00; {xF8 Divisor Latch Low Byte }π DLH = $01; {xF9 Divisor Latch Hi Byte }π CMD8259 = $20; {Interrupt Controller Command Register }π IMR8259 = $21; {Interrupt Controller Mask Register }π {Should be evaluated by any higher-level send-routine}π LoopLimit = 1000; {When does a timeout-error occur }π V24BuffSize = 2048; { Ringpuffer 2 KB }ππVARπ BiosComBaseAdr : ARRAY [Com1..Com2] OF WORD ABSOLUTE $0040:$0000;π ActivePort : ComType;π { The Com-Port base adresses are taken from the BIOS data area }π ComBase : WORD; {Hardware Com-Port Base Adress }π OldV24 : Pointer;π V24HP : WORD; {Buffer Head-Pointer }π V24BuffEnd : WORD; {Buffer End-Adress }π V24Buff : ARRAY [0..V24BuffSize] OF BYTE;π OExitHandler : Pointer; {Save-Area für Zeiger auf Org.-Exit-Proc}πππPROCEDURE V24Int; external;π{$L v24.obj}πππPROCEDURE ClearPendingInterrupts;πVARπ N : BYTE;πBEGINπ WHILE (PORT[ComBase + IIR] AND 1) = 0 DO {While Interrupts are pending}π BEGINπ N := PORT[ComBase + LSR]; {Read Line Status}π N := PORT[ComBase + MSR]; {Read Modem Status}π N := PORT[ComBase + RBR]; {Read Receive Buffer Register}π PORT[CMD8259] := $20; {End of Interrupt}π END;πEND;πππFUNCTION V24DataAvail:BOOLEAN;π{ This function checks, whether there are characters in the buffer }πBEGINπ V24DataAvail := (V24HP <> V24TP);πEND;πππFUNCTION V24GetByte:BYTE;π{ Take a byte out of the ring-buffer and return it to the caller.π This function assumes, that the application has called V24DataAvailπ before to assure, that there are characters available!!!!π The ISR only reads the current head-pointer value, so this routineπ may modify the head-pointer with interrupts enabled. }πBEGINπ V24GetByte := Mem[DSeg:V24HP];π Inc(V24HP);π IF V24HP > V24BuffEnd THENπ V24HP := Ofs(V24Buff);πEND;πππPROCEDURE SendByte(Data:BYTE);πVARπ Count : BYTE;πBEGINπ Count := 0;π V24Timeout := FALSE;π IF ComBase > 0 THENπ BEGINπ REPEATπ Count := SUCC(Count);π UNTIL ((PORT[ComBase + LSR] AND $20) <> 0) OR (Count > LoopLimit);π IF Count > LoopLimit THENπ V24Timeout := TRUEπ ELSEπ PORT[ComBase+THR] := Data;π END;πEND;πππPROCEDURE InitCom(ComPort : ComType; Baudrate : BaudType; Parity : ParityType;π Bits : DataBitsType; Stop : StopBitsType);πCONSTπ BaudConst : ARRAY [b110..b115200] OF WORD =π ($417,$300,$180,$C0,$60,$30,$18,$0C,$06,$03,$02,$01);π ParityConst : ARRAY [Space..None] OF BYTE = ($38,$08,$28,$18,$00);π BitsConst : ARRAY [d5..d8] OF BYTE = ($00,$01,$02,$03);π StopConst : ARRAY [s1..s2] OF BYTE = ($00,$04);πBEGINπ V24HP := Ofs(V24Buff);π V24TP := V24HP;π V24BuffEnd := V24HP + V24BuffSize;π FillChar(V24Buff, Succ(V24BuffSize), #0);π V24Timeout := FALSE; {Reset Timeout-Marker}π ComBase := ComBaseAdr[ComPort]; {Get Com-Port base adress}π ActivePort := ComPort; {Keep Active-Port for EOI}π ClearPendingInterrupts;π GetIntVec(IntVect[ComPort], OldV24);π SetIntVec(IntVect[ComPort], @V24Int);π {Install interrupt routine}π INLINE($FA); {CLI}π PORT[ComBase + LCR] := $80; {Adress Divisor Latch}π PORT[ComBase + DLH] := Hi(BaudConst[Baudrate]);{Set Baud rate}π PORT[COMBase + DLL] := Lo(BaudConst[Baudrate]);π PORT[ComBase + LCR] := ($00 OR ParityConst[Parity] {Setup Parity}π OR BitsConst[Bits] {Setup number of databits}π OR StopConst[Stop]); {Setup number of stopbits}π PORT[ComBase + MCR] := $0B; {Set RTS,DTR,OUT2}π(*π PORT[ComBase+MCR] := $1B; {Set RTS,DTR,OUT2,Loop}π*)π PORT[ComBase + IER] := $01; {Enable Data-Available Interrupts}π PORT[IMR8259] := PORT[IMR8259] AND IntMasks[ComPort]; {Enable V24-Interrups}π INLINE($FB); {STI}πEND;πππPROCEDURE DisableCom;πBEGINπ IF ComBase = 0 THENπ Exit;π INLINE($FA); {CLI}π PORT[ComBase + MCR] := 00; {Disable Interrupts, Reset MCR}π PORT[IMR8259] := PORT[IMR8259] OR $18; {Disable Interrupt Level 3 and 4}π PORT[ComBase + IER] := 0; {Disable 8250-Interrupts}π ClearPendingInterrupts; {Clean up}π ComBase := 0; {Reset Combase}π SetIntVec(IntVect[ActivePort], OldV24);{Reset old IV}π INLINE($FB); {STI}πEND;ππ{$F+}πPROCEDURE V24ExitProc;ππBEGIN {V24ExitProc}π DisableCom;π ExitProc := OExitHandler; { alten Exit-Handler reaktivieren }πEND; {V24ExitProc}π{$F-}πππBEGINπ {Grund-Init, damit irrtümliche Aufrufe von V24DataAvail nicht zuπ endlosen Ausgaben von Speicherschrott führen!}π Move(BiosComBaseAdr, ComBaseAdr[Com1], SizeOf(BiosComBaseAdr));π Move(BiosComBaseAdr, ComBaseAdr[Com3], SizeOf(BiosComBaseAdr));π Move(BiosComBaseAdr, ComBaseAdr[Com5], SizeOf(BiosComBaseAdr));π ComBase := 0;π V24HP := Ofs(V24Buff);π V24TP := V24HP;π V24BuffEnd := V24HP + V24BuffSize;ππ OExitHandler := ExitProc;π ExitProc := @V24ExitProc;πEND.ππ 31 11-02-9310:26ALL HELGE HELGESEN Access PCBOARD Users IMPORT 46 ╣Jkε {πHELGE HELGESENππ-> Currently I am writing the USERS File to a Temp File While imπ-> reading it (or atleast I try to), but pascal does not allowπ-> me to Write a full Record to a File.ππI suppose you're running a on a network, and that you haveπproblems accessing the USERS File directly?ππFirst of all, do you open the File in shared mode, which isπnecessary if multiple Programs to access the File simultaneous.ππ-> So could you tell me an easier way Write back theπ-> modifications that I have done. A little example would beπ-> Really cool..ππSure... Here's a little example. Tested With PCBoard configuredπfor use on network, With DESQview.ππif you'd relly try this you should reWrite the proc "ModifyRecord" first ;)π}ππProgram AccessUsersFile;ππUsesπ Dos;ππTypeπ bdReal = Array [0..7] of Byte; { I'm not sure of this one... }π bsReal = Array [0..3] of Byte; { have conversion routines For this one if you need }ππ TUser = Record { declare user Record }π Name : Array[ 1..25] of Char;π City : Array [1..24] of Char;π PassWord : Array [1..12] of Char;π Phone : Array [1..2] of Array [1..13] of Char;π LastDateOn : Array [1..6] of Char;π LastTimeOn : Array [1..5] of Char;π Expert : Char;π Protocol : Char;π SomeBitFlags : Byte;π DateOfLastDirScan : Array [1..6] of Char;π Level : Byte;π TimesOn : Word;π PageLen : Byte;π FilesUploaded,π FilesDownloaded : Word;π DownloadToday : bdReal;π Comment : Array [1..2] of Array [1..30] of Char;π ElapsedOn : Word;π RegExpDate : Array [1..6] of Char;π ExpLevel : Byte;π OldLastConfIn : Byte;π ConfRegBitFlags,π ExpRegBitFlags,π UserSelBitFlags : Array [0..4] of Byte;π TotBytesDown,π TotBytesUp : bdReal;π DeleteFlag : Char;π LRP : Array [0..39] of bsReal; { last read Pointers }π RecNoInUsersInf : LongInt;π MoreBitFlags : Byte;π RFU : Array [1..8] of Char;π LastConfIn : Word;π end;ππ TIndex = Record { PCBNDX Files }π RecNo : Word;π Name : Array [1..25] of Char;π end;ππVarπ UsersFile : File of TUser;π PathToIndexes : String; { path to index Files, With 'PCBNDX.' added }π Users : TUser; { global Record - users Record }ππProcedure OpenUsersFile;πVarπ t : Text;π s : String;π x : Byte;πbeginπ s := GetEnv('PCBDAT');π if length(s) = 0 thenπ halt; { if I can't find PCBOARD.DAT I can't find USERS File either }π assign(t, s); {$I+}π reset(t); { open File, will terminate if any error }π For x := 1 to 28 doπ readln(t, s);π PathToIndexes := s + 'PCBNDX.';π FileMode := 66;π readln(t, s);π assign(UsersFile, s);π reset(UsersFile);π close(t);πend;ππFunction FindUserRec: Word;π{ Searches thru index File For name. if not found, $FFFF is returned. }πVarπ name : String;π IndexFile : File of TIndex;π x : Byte;π Found : Boolean;π Index : TIndex;πbeginπ Write('Enter name of user to modify: ');π readln(name);π FindUserRec := $ffff;π x := length(name);π name[0] := #25; { make 25 Char name }π For x := x + 1 to 25 doπ name[x] := #32;π For x := 1 to 25 doπ name[x] := UpCase(name[x]); { make upper Case }π{ since PCBoard v15.0 supports national Chars, you should do it too. Ifπ you need, I have something on this too... ;) }π assign(IndexFile, PathToIndexes + name[1]);π reset(IndexFile);π Repeatπ read(IndexFile, Index); { read name }π x := 1;π While (x <= 25) and (name[x] = Index.Name[x]) doπ inc(x);π Found := x = 26;π Until eof(IndexFile) or Found;π if Found thenπ FindUserRec := Index.RecNo - 1;π{ Please note that I subtract 1 here. This is becase PCBoard was written inπ Basic (when the File format was made) and that Basic threats Record 1 asπ the first Record. In Pascal, Record 0 is the first Record! This may confuseπ a bit since some Files Within PCBoard are 1-based, and some are 0-based. }π close(IndexFile);πend;ππProcedure ModifyRecord;π{ Let's modify the Record... }πVarπ x : Byte;πbeginπ Write('Users name: ');π For x := 1 to 25 doπ Write(Users.Name[x]);π Writeln; { For verification only... }π Users.Protocol:='Z'; { let's make him use Zmodem }π inc(Users.PassWord[1]); { and give him some headache }π Users.PageLen := 0; { and make the screen go non-stop, when he gets on again... }πend;ππVarπ x : Word;πbeginπ OpenUsersFile;π x := FindUserRec;π if x = $ffff thenπ beginπ Writeln('Can''t locate user, sorry...');π close(UsersFile);π halt; { can't find user... }π end;π seek(UsersFile, x); { seek to the Record }π read(UsersFile, Users); { and read the Record }π seek(UsersFile, x); { seek back to the Record }π ModifyRecord; { make some modificatios... }π Write(UsersFile, Users); Writeln('Modifiations written back...');π close(UsersFile);πend.ππππVarπ Cnames : File;π PCBConf : PCBConfType; { your declaration }ππbeginπ { And now we need to open it }π assign(Cnames, 'CNAMES.@@@'); { I assume is't local }π FileMode := 66; { open in shared mode }π reset(Cnames, 1); { NB! Make RecSize = 1! }ππ { Now, let's read the Record length. I assume X is an Word! }π blockread(Cnames, x, sizeof(x));ππ { And now it's time to seek to conference Y(also a Word). }π seek(Cnames, 2 + y * x);ππ { And read the Record. }π blockread(Cnames, PCBConf, sizeof(PCBConf));ππ { There. if you want to Write back some modifications, }π seek(Cnames, 2 + x * y); { seek back to Record }π blockWrite(Cnames, PCBConf, sizeof(PCBConf));ππ 32 11-02-9310:31ALL HELGE HELGESEN PCBOARD Data IMPORT 27 ╣J*É {πHELGE HELGESENππ> but i don't know how to change the user informationπ> (Like users City/State For instance).ππLet's see... I'm not sure if it works if the user you want toπmodify is on-line, but if he isn't, this should work.ππFirst, locate the user in the index Files. It's organized asπthis. if the name is less than 25 Chars, it's filled up Withπspaces.π}ππTypeπ TUserIndex = Recordπ RecNo : Word;π Name : Array[1..25] of Char;π end;ππ{πThe first letter of name is used as extention to the index Files.πTo find me, you have to look into the File "PCBNDX.H". It'sπstored as FIRSTNAME LASTNAME. (The path to the user indexes areπlocated in line 28 of "PCBOARD.DAT".)ππWhen you have found the Record no, simply seek to the Record inπthe File specified in line 29 of "PCBOARD.DAT". The layout looksπlike this:ππ Offset Type Length Descriptionπ ------ ------ ------ -----------π 0 str 25 Full Nameπ 25 str 24 Cityπ 49 str 12 PassWordπ 61 str 13 Business / Data Phone Numberπ 74 str 13 Home / Voice Phone Numberπ 87 str 6 Last Date On (format: YYMMDD)π 93 str 5 Last Time On (format HH:MM)π 98 Char 1 Expert Mode (Y or N)π 99 Char 1 Default Transfer Protocol (A-Z, 0-9)π 100 bitmap 1 Bit Flags (see below)π 101 str 6 Date of Last DIR Scan (most recent File found)π 107 Char 1 Security Level (0-255)π 108 int 2 Number of Times Onπ 110 Char 1 Page Length (# lines displayed before prompt)π 111 int 2 Number of Files Uploadedπ 113 int 2 Number of Files Downloadedπ 115 bdReal 8 Total Bytes Downloaded Todayπ 123 str 30 Comment Field #1 (user comment)π 153 str 30 Comment Field #2 (sysop comment - user can't see)π 183 int 2 Elapsed Time On (in minutes)π 185 str 6 Registration Expiration Date (YYMMDD)π 191 Char 1 Expired Registration - Security Levelπ 192 Char 1 Last Conference In (used For v14.x compatibility)π 193 bitmap 5 Conference Registration Flags (conf 0-39)π 198 bitmap 5 Expired Registration Conference Flags (conf 0-39)π 203 bitmap 5 User Selected Conference Flags (conf 0-39)π 208 bdReal 8 Total Bytes Downloadedπ 216 bdReal 8 Total Bytes Uploadedπ 224 Char 1 Delete Flag (Y or N)π 225 bsReal 4 Last Message Read Pointer (conference 0)π 229 bsReal 4 Last Message Read Pointer (conference 1)π ... bsReal 4 (continued each conference)π 381 bsReal 4 Last Message Read Pointer (conference 39)π 385 long 4 Record Number of USERS.INF Recordπ 389 bitmap 1 Bit Flags 2 (see below)π 390 str 8 Reserved (do not use)π 398 int 2 Last Conference In (used instead of offset 192)ππSo all you have to do is to read the Record, make theπmodifications and Write it back.ππJust remember to open the Files in shared mode! (FileMode:=66;).π}π 33 01-27-9411:53ALL REUBEN NELSON Bluewave Structures IMPORT 24 ╣JR% {πI created the following purly from my observations of the Bluewave files thatπI have reiceived. There are parts that I believe to be incorrect, such as theπlast five variables in the MIXRec record. I have worked very hard on this, soπif you use the following please give me my due creidit in the program orπdocumentation.ππThe BBSNAME.FTI file is made up of FTIRec records.ππThe BBSNAME.INF file is made up of one INFRec record and an unknown numberπof ConfRec records.ππThe BBSNAME.MIX file is made up of an unknown number of MIXRec records.ππThe BBSNAME.DAT file is a file of char indexed by the FTIRec records.π}ππ FTIRec = Recordπ FromName : Array[1..36] of Char;π ToName : Array[1..36] of Char;π Subject : Array[1..72] of Char;π Date : Array[1..10] of Char;π Time : Array[1..10] of Char;π MsgNum : Word;π BackThread : Word; { I'm not sure if this is the offset in }π ForwardThread : Word; { the FTI file or the message number }π MsgOfs : LongInt; { Offset in DAT file (bytes) }π MsgLength : LongInt; { Length of msg in DAT file (bytes) }π Flags : Word; { Bit 1 = Privateπ Bit 2 = Crashπ Bit 3 = Rec'dπ Bit 4 = Sentπ Bit 5 = File Attachπ Bit 6 =π Bit 7 =π Bit 8 = Kill Sentπ Bit 9 = Localπ Bit 10 =π Bit 12 =π Bit 13 = Req Receiptπ Bit 14 =π Bit 15 = Return Receiptπ Bit 16 = Audit Req }π Zone : Word; { Fidonet Zone }π Net : Word; { Fidonet Net }π Node : Word; { Fidonet Node }π end; { Total length of record is 186 }ππ INFRec = Recordπ UnKnown : Byte; { I don't know what this is seems to always be 2 }π InfoFiles : Array[1..5] of Array[1..15] of Char;π UserName : Array[1..43] of Char;π UserAlias : Array[1..65] of Char;π Zone, Net, Node, Point : Word; { The BBS's fidonet address }π SysOpName : Array[1..43] of Char;π SystemName : Array[1..65] of Char;π { The rest of this record is just a shot in the dark }π NumMacros : Word; { The number of macros allowed by the door }π Extra1 : Array[1..7] of Char;π KeyWords : Array[1..10] of Array[1..21] of Char; { The keywords }π Filters : Array[1..10] of Array[1..21] of Char; { The filters }π Macros : Array[1..3] of Array[1..75] of Char; { The macros }π end;ππ ConfRec = Recordπ Number : Array[1..6] of Char;π Label : Array[1..21] of Char;π Title : Array[1..50] of Char;π ConfType : Byte;π Extra : Word;π end;ππ MIXRec = Recordπ AreaNumber : Array[1..6] of Char;π NumMsgs : Word;π PersonalMsgs : Word;π OffsetInFTI : LongInt;π end;π 34 01-27-9411:56ALL NORBERT IGL Uart Detection IMPORT 12 ╣J{µ {π> I'm looking for a pascal V6 program to detect the UART-type installed.π}ππprogram ComType;ππ{ Detect the type/presence of a comport-chip.π Norbert Igl, 5/92 }ππusesπ crt;ππConst ComPortText :π Array[0..4] of String[11] =π (' N/A ',π '8250/8250B ',π '8250A/16450',π ' 16550A ',π ' 16550N ');π IIR = 2;π SCRATCH = 7;ππVar PortAdr : Array[1..4] of Word absolute $40:0;ππfunction ComPortType(ComX:byte):byte;ππBEGINπ ComPortType:=0;π if (PortAdr[ComX] =0)π or (Port[PortAdr[ComX]+ IIR ] and $30 <> 0)π then exit; {No ComPort !}π Port[PortAdr[ComX]+ IIR ] := 1; {Test: enable FIFO}π if (Port[PortAdr[ComX]+IIR] and $C0) = $C0 {enabled ?}π then ComPortType := 3π else If (Port[PortAdr[ComX]+IIR] and $80) = $80 {16550,old version..}π then ComPortType := 4π else beginπ Port[Portadr[ComX]+SCRATCH]:=$AA;π if Port [Portadr[ComX]+SCRATCH]=$AA {w/ scratch reg. ?}π then ComPortType:= 2π else ComPortType:= 1;π end;πEND;ππvar com : byte;ππbeginπ clrscr;π writeln('COMPORT Chiptest':75);π writeln('Freeware by Norbert Igl, Germany':75);π writeln;π for com := 1 to 4 doπ writeln('COM:',com,': ', ComPortText[ComPortType(com)]);πend.π 35 01-27-9412:24ALL MAYNARD PHILBROOK Uart Info IMPORT 13 ╣Jé {πI can give you a brief run on a UART of the 8250 line.ππReg 0 used for sending or Recieving a byte;πReg 1 Interrupt Enable: Bits 0= RX, 1=TX, 2=Serial ERROR, 3=ModemInputStatusπReg 2 Interrupt ID : if Bit 0 set then no interrupt has happen elseπ Bits 1=RXready,2=TxEmty,3=Serial error, 4= ModemInputStatus;ππReg 3 Data Format Line Control;π Bits 0,1 Select Word Size 0=5,1=6,2=7,3=8π 2 Stops Bits On = 2, oFf - 1;π 3,4,5 :Parity 0=none,1=odd,3=even,5=mark,7=space;π 6 Break Control off = off, on = onπ 7 Devisor latch control;π Must set this on to have reg 0,1 used as 16 bit value toπ BAUD Rate;π divisor =(1843200 div (16 * desired baud rate));π(89 min left), (H)elp, More? When done set bit 7 to off.πreg 4 OutputControlπ 0 = DTR,1= RTS, 2,3 = GPO, 4 = LoopBack Test;πReg 5 Serial Status reg;π 0 = Data Ready on RX line;π 1 = over run, 2= parity errro,3= frame error, 4= break detected,π 5= TXbuffer empty, 6 = Tx Output Reg empty.πReg 6 Modem INputsπ 0-3 are Delta Bits, meaning they are set when a change has happenπ in the state of the DRS,CTS,RI,DCD since last time, when read theseπ bits will clear.π 4 = CTS , 5 = DSR, 6 RI. 7 DCD;π { ^^^ Reports the current logit level of these inputs }π { all Delta Bits are in the same alignment bit wise. }π{ Hope this helps }ππ 36 01-27-9412:24ALL BJORN FELTEN Uart Detection IMPORT 18 ╣JD° {π > I'm looking for a small pascal V6 program to detectπ > the UART-type installed.ππ Sure. How small do you need it? Here's one that'll compile to something justπbelow 3kb, will that do?π }ππfunction UART(Port: word): word; assembler;π{ Checks for UART, and, if one is present, what type. }π{ Returns 0 if no UART, 1 if UART but no 16550, 2 if 16550 }π{ Donated to the public domain by Björn Felten @ 2:203/208 }π{ Partly from an asm program by Anders Danielsson @ 2:203/101 }πasmπ mov cx,Port {1..4}π push dsπ mov ds,seg0040 {Use BIOS table to find port addr}π xor si,si {Offset 0 in BIOS table segment}π rep lodsw {Get the right one}π pop dsπ or ax,ax {Test port address}π jz @no_uart {If zero --> no port}π mov dx,ax {Base address}π add dx,4 {Base+4}π cliπ in al,dx {Modem Control Register}π and al,11100000b {Check bit 5-7}π jnz @no_uart {Non-zero --> no UART}π sub dx,2 {Base+2}π jmp @1 {Give hardware some time}π@1:π in al,dx {Interrupt Identification Register}π and al,11110000b {Check bit 4-7}π cmp al,11000000b {FIFO enabled?}π jz @is16550 {Yes, it is a 16550}π and al,00110000b {Check reserved bits}π jnz @no_uart {Non-zero --> No UART}π mov al,00000111b {16550 FIFO enable}π out dx,al {FIFO control register}π jmp @2π@2:π in al,dx {FIFO control register}π and al,11110000b {Check bit 4-7}π mov ah,al {Save for later}π jmp @3π@3:π mov al,00000110b {16550 FIFO disable}π out dx,al {FIFO control register}π cmp ah,11000000b {FIFO still not enabled?}π jz @is16550 {Yes, it is a 16550}π mov ax,1π jmp @quitπ@is16550:π mov ax,2π jmp @quitπ@no_uart:π xor ax,axπ@quit:π stiπend;ππvar P: word;πbeginπ for P:=1 to 4 doπ case UART(P) ofπ 0: writeln('No UART on port COM',P);π 1: writeln('UART, but not 16550, on port COM',P);π 2: writeln('16550 UART on port COM',P);π endπend.π 37 01-27-9417:33ALL NORBERT IGL Carrier Detect IMPORT 9 ╣J ) πunit cdchk;ππInterfaceππ Function CarrierDetected( ComPort : byte ) : Boolean;ππImplementationππ Function CarrierDetected( ComPort : byte ) : Boolean;ππ Const MSR = 6;ππ VARπ BASEPORT : Array[0..3] Of Word absolute $40:0;ππ VAR P : Word;ππ beginπ CarrierDetected := FALSE; { Assume no Carrier }π dec( ComPort );π if ComPort in [0..3] then { range check for COMx }π begin { ... not valid ? }π P := BasePort[ComPort]; { Bios-Var for COMx... }π If P <> 0 then { ... not assigned ?! }π beginπ CarrierDetected := (Port[P+ MSR] And $80) = 0;π end;π endπ end;π { No Initializing ... }π end.ππ-------------------------------------------------------------π P.S.: If P=0 ...π Port[P+MSR] ==> Port[6]π this would read the DMA Channel#3-LowAdress-Byte .... (:-))π-------------------------------------------------------------π 38 01-27-9417:34ALL ELAD NACHMAN Simple COM I/O IMPORT 27 ╣J══ {πFrom: ELAD NACHMANπSubj: High Speed COM I/Oπ---------------------------------------------------------------------------π RL> Dose anyone know how a humble young TP programmer can accessπ RL> modems at speeds of say 57,600 baud rates? I would love evenπ RL> 14,400 routines. I had a set of simple I/O routines, but speedsπ RL> over 2400 term programs would lose characters. I would like toπ RL> write some doors for a BBS but can't break the 2400 limit.ππYou probably use a very simple way, which doesn't envolves capturing theπmodem's Com port IRQ. That's why you use chars over faster transmitions.πTo make sure the program will be fast, optimize it to assembler, or at leastπuse I/O Ports manipulations (If you odn't use it already).πA cut from a source I have here (Design for com1, if you need support for otherπports use a guide such as Helppc. If you want To write Doors for BBSes youπbetter use Fossil functions, For that either use Fsildoc.??? (It's in severalπFTP sites) or Ralf Brown's Interrupt list):π}ππconstππ{ 8250 IRQ Registers }ππData=$03f8; { Contains 8 bits for send/receive }ππIER=$03f9; { Enables Serial Port when set to 1 }ππLCR=$03fb; { Sets communication Parameters }ππMCR=$03FC; { bits 1,2,4 are turned on to ready modems }ππLSR=$3FD; { when bit 6 is on, it is safe to send a byte }ππMDMMSR=$03FE; { initialized to $80 when starting }ππENBLRDY=$01; { initial value for port[IER] }ππMDMMOD=$0b; { initial value for port[MCR] }ππMDMCD=$80; { initial value for port[MDMMSR] }ππINTCTLR=$21; { port for 8259 interrupt controller }ππvarππmybyte:byte;πvector:pointer;πππprocedure asyncint; interrupt;πbeginπinline($FB); {STI}πmybyte:=port[dataport];πinline($FA); {CLI}ππPort[$20]:=$20;ππend;ππprocedure setmodem;πvarπregs: registers;πparm : byte;ππbeginππparm:=3+4+0+$d0;π{8 databits,1 stopbit,no parity,9600 baud}π{databits: values 0,1,2,3 represent 5,6,7,8 databitsπstopbits: value 4 is for 1 stopbits, 0 for noneπparity: value 0 or $10 for none, $8 for odd, $18 for evenπbaud: $d0 for 9600, $b0 for 4800, $a0 for 2400, $80 for 1200, $60 for 600, $40πfor 300 add all this values and get the correct byte parameter}ππwith regs doπbeginπdx:=0; { comport -1 }πah:=0;πal:=parm;πflags:=0;πintr($14,regs);πend;πend;ππprocedure EnablePorts;πvarπb: byte;πbeginπgetintvec($0c,Vector); { $0c is for com1/com3 - IRQ 4 }πsetintvec($0c,@AsyncInt);πb:=port[INTCTLR];πb:=b and $0ef;πport[INTCTLR]:=b;πb:=port[LCR];πb:=b and $7f;ππport[lcr]:=b;πport[ier]:=enblrdy;πport[mcr]:=$08 or MDMMOD;πport[mdmmsr]:=mdmcd;πport[$20]:=$20;ππ{ when: port[MDMMSR] and $80 = $80 then there's carrier }ππprocedure sendchartoport(b: byte);πbeginπwhile ( (port[lsr] and $20) <> $20 ) doπbeginπend;πport[dataport]:=b;πend;ππprocedure sendstringtoport(s: string);πvarπi:integer;πbeginπfor i:=1 to length(s) doπsendchartoport(ord(S[i]));πsnedchartoport(13);πend;ππprocedure disableports;πvarπb: byte;πbeginπsendstringtoport('ATC0');πb:=port[intctlr];πb:=b or $10;πport[intctlr]:=b;πb:=port[lcr];πb:=b and $7f;πport[lcr]:=b;πport[ier]:=$0;ππport[mcr]:=$0;πport[$20]:=$20;πsetintvec($0c,vector);πend;ππ{ How the program itself should generally be }ππbeginππsetmodem;πenableports;πsend strings or charsπdisableports;ππend.π 39 01-27-9417:36ALL MIGUEL MARTINEZ Accessing The Phone IMPORT 9 ╣J═W {πFrom: MIGUEL MARTINEZπSubj: Accessing the phoneπ---------------------------------------------------------------------------π ▒ I am a novice programmer and I am writing an address book type programπ ▒ in TP 6.0. How can I send the phone a number to be dialed? Thanx.ππTry this routines:π}ππUSES CRT;ππProcedure DialNumber(Number:String);πVar ComPort:Text;π ComName:String;πBeginπ ComName:='COM2'; (* Assuming your modem is located there *)π Assign(ComPort,ComName);π ReWrite(ComPort);π Writeln(ComPort,'ATDT'+Number);π Close(ComPort);πEnd;ππProcedure Hangup;πVar ComPort:Text;π ComName:String;πBeginπ ComName:='COM2'; (* Assuming your modem is located there *)π Assign(ComPort,ComName);π ReWrite(ComPort);π Writeln(ComPort,'ATH0M1');π Close(ComPort);πEnd;ππ{An example of how to use this routines, is this fragment of code:}πBEGINπ DialNumber('345554323');π Repeat Until Keypressed;π Hangup;πEND.ππIf you don't hang up, guess... You'll get a funny noise if you don'tπconnect. :)ππ 40 01-27-9417:36ALL WIN VAN DER VEGT Simple Phone Dialer IMPORT 11 ╣J═W {πFrom: WIM VAN DER VEGTπSubj: Accessing the phoneπ---------------------------------------------------------------------------πThanks, works great and is quite simple. Have modified it a litte so itπattaches the ATDT command and waits for the user to pick up the phone.πAfter that it hangs-up the modem. I forgot how easy it is to sendπSOME characters to the serial port.π}ππUsesπ Crt;ππPROCEDURE PhoneDialler (Number : String; Port : Byte);ππvarπ SerialPort : text; { Yes, a text file! }ππbeginπ Case Port ofπ 1 : Assign (SerialPort, 'COM1');π 2 : Assign (SerialPort, 'COM2');π 3 : Assign (SerialPort, 'COM3');π 4 : Assign (SerialPort, 'COM4');π end; { CASE }π Rewrite (SerialPort);ππ Writeln('Tone dialing ',Number,'.');π Writeln (SerialPort, 'ATDT'+Number);ππ {----Should be large enough to dial the longest number}π Delay(6*1000);ππ Write('Pick up the phone, then press space ');π WHILE NOT(Keypressed AND (Readkey=#32)) DOπ Beginπ Write('.');π Delay(1000);π End;π Writeln;ππ Writeln('Shuting down modem.');π Writeln (SerialPort,'ATH0');π Close (SerialPort)πend; { of PROCEDURE 'Phone Dialler' }ππBeginπ PhoneDialler('045-762288',2);πEnd.π 41 02-05-9407:56ALL KELLY SMALL Baud Rates IMPORT 27 ╣J8 {πCan anyone tell me how you would set the baud rate for a speed above 9600 BPπin the bit mask for int 14h. also how you could do a Null modem typeπconnection.ππYou can't. You must program the divisor in the uart your selfπfor those higher baudrates. Here's part of a serial routine Iπuse:π}ππUnit SerialIn;π{F+}πInterfaceπUses Crt,Dos;πConst CommPort = $3F8; { normally com1 = $3F8 and com2 = $2F8 }π CommIrq = 4; { normally com1 = 4 and com2 = 3 }π BaudRate = 9600; { 300 - 9600 }π Parameters = $03; { 7 6 5 4 3 2 1 0π +-+-+ +-+ | +-+--- width 10 = 7 bitsπ don't | | 11 = 8 bitsπ care | +------- stopbit 0 = 1 bitπ | 1 = 2 bitπ +---------- parity X0 = noneπ 01 = oddπ 11 = even }ππ BufferSize = 1000; { Size of receiver buffer }π IntMask : Array[2..5] of Byte = ($FB,$F7,$EF,$DF);ππVar ComBuffer : Array[0..Buffersize] of Byte;π HeadPtr,π TailPtr : Integer;π OldCommInt : Pointer;ππProcedure ComInit; { Initialize serial port }πProcedure ComDisable; { Disable serial port }πProcedure SendChar(Ch:Char); { Send character to serial port }πProcedure SendString(Message:String); { Send string to serial port}πFunction GetChar:Char; { Get character from serial port }πFunction GetCharWait:Char; { Wait for character ready, then get }πFunction CharReady:Boolean; { Returns true if character has been }π { received through serial port }ππImplementationππProcedure ComInit; { get the serial port ready for use }πVar Divisor : Integer; { this routine MUST be called before }π Dummy : Integer; { using serial port! }π Beginπ Case BaudRate ofπ 300 : Divisor := 384;π 1200 : Divisor := 96;π 2400 : Divisor := 48;π 9600 : Divisor := 12;π 19200 : Divisor := 6;π 3840 : Divisor := 3;π 5760 : Divisor := 2;π 11520 : Divisor := 1;π Else WriteLn('Illegal Baudrate');π End;π Port[CommPort+3] := $80; { Set divisor latch bit }π Port[CommPort] := Lo(Divisor); { Set lower divisor }ππ Port[CommPort+1] := Hi(Divisor); { set upper divisor }π Port[CommPort+3] := Parameters; { clear divisor latch and }π { set data parameters }π HeadPtr := 0; { reset buffer pointers }π TailPtr := 0;π GetIntVec(CommIrq+8,OldCommInt); { Save the old vector }π SetIntVec(CommIrq+8,@ComIntHandler); { Install interrupt handler }π Port[CommPort+1] := 1; { Enable receiver interrupt }π Port[CommPort+4] := 9; { Enable DTR and OUT2 }π Port[$21] := Port[$21] Andπ IntMask[CommIrq]; { Program 8259 Int mask }π Dummy := Port[CommPort]; { Read the receiver register }π End; { to clear status flags }π 42 02-15-9407:43ALL SWAG SUPPORT TEAM Check ALL COM ports IMPORT 16 ╣J$⌡ πPROGRAM ComChk;ππUSES Crt;ππ FUNCTION HexWord(a : Word) : String;π CONSTπ Digit : ARRAY[$0..$F] OF Char = '0123456789ABCDEF';π VARπ I : Byte;π HexStr : String;ππ BEGINπ HexStr := '';π FOR I := 1 TO 4 DOπ BEGINπ Insert(Digit[a AND $000F], HexStr, 1);π a := a SHR 4π END;π HexWord := HexStr;π END; {hex}πππPROCEDURE UncodePort(NR : integer);π VARπ B, M, V1, V2, TLRC, D, MSB, LSB : integer;π S, CO : integer;π Baud : real;π Answer : string[10];π ComList : array[1..4] OF word ABSOLUTE $0000:$0400;π BEGINπ CO := ComList[NR];π WriteLn;π WriteLn ('Communications Port ', NR, ':');π IF CO = 0 THENπ BEGINπ WriteLn (' Not installed.');π Exit;π END;ππ S := Port[CO + 3];π TLRC := Port[CO + 3];π Port[CO + 3] := TLRC OR $80;π LSB := Port[CO];π MSB := Port[CO + 1];π D := 256 * MSB + LSB;π Baud := 115200.0 / D;π Port[CO + 3] := TLRC AND $7F;ππ {Display port address}π WriteLn (' Port address: ', HexWord (ComList[NR]));ππ {Display baud rate}π WriteLn (' Baud rate: ', Baud:5:0);ππ {Display data bits}π IF (S AND 3) = 3 THENπ B := 8π ELSE IF (S AND 2) = 2 THENπ B := 7π ELSE IF (S AND 1) = 1 THENπ B := 6π ELSEπ B := 5;π WriteLn (' Data bits: ', B:5);ππ {Display stop bits}π IF (S AND 4) = 4 THENπ B := 2π ELSEπ B := 1;π WriteLn (' Stop bits: ', B:5);ππ IF (S AND 24) = 24 THENπ Answer := 'Even'π ELSE IF (S AND 8) = 8 THENπ Answer := 'Odd'π ELSEπ Answer := 'None';π WriteLn (' Parity: ', Answer:5);π END; {procedure Uncode_Setup_Of_Port}ππBEGINπ ClrScr;π WriteLn ('Communications Port Status--------------------------');π UncodePort (1);π UncodePort (2);π UncodePort (3);π UncodePort (4);πEND.ππ 43 05-25-9408:14ALL GREG VIGNEAULT Reading UART baud rate...SWAG9405 22 ╣Jⁿv π{π Here's a TP function that will report the current UART baud rate forπ any serial port device (modem, mouse, etc.) ...π}ππ(*************************** GETBAUD.PAS ***************************)πPROGRAM GetBaud; { compiler: Turbo Pascal 4.0+ }π { Mar.23.94 Greg Vigneault }ππ(*-----------------------------------------------------------------*)π{ get the current baud rate of a serial i/o port (reads the UART)...}ππFUNCTION SioRate (ComPort :WORD; VAR Baud :LONGINT) :BOOLEAN;π CONST DLAB = $80; { divisor latch access bit }π VAR BaseIO, { COM base i/o port address }π BRGdiv, { baud rate generator divisor }π regDLL, { BRG divisor, latched LSB }π regDLM, { BRG divisor, latched MSB }π regLCR :WORD; { line control register }π BEGINπ Baud := 0; { assume nothing }π IF (ComPort IN [1..4]) THEN BEGIN { must be 1..4 }π BaseIO := MemW[$40:(ComPort-1) SHL 1]; { fetch base i/o port }π IF (BaseIO <> 0) THEN BEGIN { has BIOS seen it? }π regDLL := BaseIO; { BRGdiv, latched LSB }π regDLM := BaseIO + 1; { BRGdiv, latched MSB }π regLCR := BaseIO + 3; { line control reg }π Port[regLCR] := Port[regLCR] OR DLAB; { set DLAB }π BRGdiv := WORD(Port[regDLL]); { BRGdiv LSB }π BRGdiv := BRGdiv OR WORD(Port[regDLM]) SHL 8; { BRGdiv MSB }π Port[regLCR] := Port[regLCR] AND NOT DLAB; { reset DLAB }π IF (BRGdiv <> 0) THENπ Baud := 1843200 DIV (LONGINT(BRGdiv) SHL 4); { calc bps }π END; {IF BaseIO}π END; {IF ComPort}π SioRate := (Baud <> 0); { success || failure }π END {SioRate};ππ(*-----------------------------------------------------------------*)ππVAR ComPort : WORD; { will be 1..4 }π Baud : LONGINT; { as high as 115200 bps }ππBEGIN {GetBaud}ππ REPEATπ WriteLn; Write ('Read baud rate for which COM port [1..4] ?: ');π ReadLn (ComPort);π IF NOT SioRate (ComPort, Baud) THEN BEGINπ Write ('!',CHR(7)); {!beep}π CASE ComPort OFπ 1..4 : WriteLn ('COM',ComPort,' is absent; try another...');π ELSE WriteLn ('Choose a number: 1 through 4...');π END; {CASE}π END; {IF}π UNTIL (Baud <> 0);ππ WriteLn ('-> COM',ComPort,' is set for ',Baud,' bits-per-second');ππEND {GetBaud}.π 44 05-25-9408:24ALL JONAS MALMSTEN UART SWAG9405 32 ╣JT▌ π{πI've read some questions latelly with questions about how to use a com-port inπpascal. I've written a couple of procedures for doing this. The followingπroutines can be improved, for example they can be satt to run on interruptsπand a few other thing, but... I'm not supposed to do all the job for you, amπI??π}ππUSES CRT,DOS;πππCONSTπ Com1 : WORD = 1;π Com2 : WORD = 2;ππtypeπ port = objectπ port: byte;π base: word;π baud: longint;π inter: byte;π function init(comport: word; baudrate: longint): boolean;π function sendchar(c: char): boolean;π function getchar(var c: char): boolean;π end;ππfunction port.init(comport: word; baudrate: longint): boolean;πvarπ tmp: word;π bas: word;π test: byte;πbeginπ if odd(comport) then inter:=$C else inter:=$B;π {This is for later use with interrupts...}π init:=false;π if comport<5 thenπ beginπ asm {get port base address}π mov bx,40hπ mov es,bxπ mov bx,comportπ dec bxπ shl bx,1π mov ax,es:[bx]π mov bas,axπ end;π if bas=0 thenπ beginπ writeln('Could''n find selected com-port!');π exit;π end;π endπ elseπ beginπ case comport of {don't know where to find ps/2 etdπ bios, standard base is supposed}π 5: bas:=$4220;π 6: bas:=$4228;π 7: bas:=$5220;π 8: bas:=$5228;π end;π end;π base:=bas;π tmp:=115200 div baudrate; {baudrate divisor}π asm {lower DTS and DSR}π mov dx,basπ add dx,4π xor al,alπ out dx,alπ end;π delay(50);π asm {raise DTS and DSR}π mov dx,basπ add dx,4π mov al,11bπ out dx,alπ end;π asm {set baudrate and N,8,1}π mov dx,basπ add dx,3π mov al,10000011b {N,8,1, set baudrate divisor}π out dx,alπ mov ax,tmp {baudrate divisor}π mov dx,basπ out dx,alπ inc dxπ mov al,ahπ out dx,alπ mov dx,basπ add dx,3π mov al,00000011b {N,8,1}π out dx,alπ end;π asm {interrupt enable, no interrupts enabled --> gain time}π mov dx,basπ inc dxπ xor al,alπ out dx,alπ end;π asm {raise DTS and DSR}π mov dx,basπ add dx,4π mov al,11bπ out dx,alπ in al,dxπ and al,11bπ mov test,alπ end;π if test<>3 thenπ beginπ writeln('Some error....');π exit;π end;π init:=true;πend;ππfunction port.sendchar(c: char): boolean;πvarπ bas: word;π cts: byte;πlabelπ no_send;πbeginπ cts:=0;π bas:=base;π asmπ mov dx,basπ add dx,5π in al,dxπ and al,00100000b {test CTS (Clear To Send status)}π jz no_sendπ mov cts,1π mov dx,basπ mov al,cπ out dx,alπ no_send:π end;π if cts=0 then sendchar:=false else sendchar:=true;πend;ππfunction port.getchar(var c: char): boolean;πvarπ bas: word;π rts: byte;π c2: char;πlabelπ no_data;πbeginπ rts:=0;π bas:=base;π asmπ mov dx,basπ add dx,5π in al,dxπ and al,00000001b {test for data ready}π jz no_dataπ mov rts,1π mov dx,basπ in al,dxπ no_data:π mov c2,alπ end;π c:=c2;π if rts=0 then getchar:=false else getchar:=true;πend;πππvarπ modem: port;π s: string;π a: byte;π c : Char;ππbeginπ if not modem.init(com2,38400) thenπ beginπ writeln('Couldn''t initialize modem...');π halt;π end;π s:='atz'+#13;π for a:=1 to length(s) do modem.sendchar(s[a]);ππend.πππIf you think these routines are just great and you decide to use them as theyπare I wouldn't mind if you gave me a credit.π 45 05-26-9407:29ALL SCOTT BAKER Fossil Driver IMPORT 40 ╣J╣Ü unit ddfossil;π{$S-,V-,R-}ππinterfaceπuses dos;ππconstπ name='Fossil drivers for TP 4.0';π author='Scott Baker';πtypeπ fossildatatype = recordπ strsize: word;π majver: byte;π minver: byte;π ident: pointer;π ibufr: word;π ifree: word;π obufr: word;π ofree: word;π swidth: byte;π sheight: byte;π baud: byte;π end;πvarπ port_num: integer;π fossildata: fossildatatype;ππprocedure async_send(ch: char);πprocedure async_send_string(s: string);πfunction async_receive(var ch: char): boolean;πfunction async_carrier_drop: boolean;πfunction async_carrier_present: boolean;πfunction async_buffer_check: boolean;πfunction async_init_fossil: boolean;πprocedure async_deinit_fossil;πprocedure async_flush_output;πprocedure async_purge_output;πprocedure async_purge_input;πprocedure async_set_dtr(state: boolean);πprocedure async_watchdog_on;πprocedure async_watchdog_off;πprocedure async_warm_reboot;πprocedure async_cold_reboot;πprocedure async_Set_baud(n: integer);πprocedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);πprocedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);ππimplementationππprocedure async_send(ch: char);πvarπ regs: registers;πbegin;π regs.al:=ord(ch);π regs.dx:=port_num;π regs.ah:=1;π intr($14,regs);πend;ππprocedure async_send_string(s: string);πvarπ a: integer;πbegin;π for a:=1 to length(s) do async_send(s[a]);πend;ππfunction async_receive(var ch: char): boolean;πvarπ regs: registers;πbegin;π ch:=#0;π regs.ah:=3;π regs.dx:=port_num;π intr($14,regs);π if (regs.ah and 1)=1 then begin;π regs.ah:=2;π regs.dx:=port_num;π intr($14,regs);π ch:=chr(regs.al);π async_receive:=true;π end else async_receive:=false;πend;ππfunction async_carrier_drop: boolean;πvarπ regs: registers;πbegin;π regs.ah:=3;π regs.dx:=port_num;π intr($14,regs);π if (regs.al and $80)<>0 then async_carrier_drop:=false else async_carrier_drop:=true;πend;ππfunction async_carrier_present: boolean;πvarπ regs: registers;πbegin;π regs.ah:=3;π regs.dx:=port_num;π intr($14,regs);π if (regs.al and $80)<>0 then async_carrier_present:=true else async_carrier_present:=false;πend;ππfunction async_buffer_check: boolean;πvarπ regs: registers;πbegin;π regs.ah:=3;π regs.dx:=port_num;π intr($14,regs);π if (regs.ah and 1)=1 then async_buffer_check:=true else async_buffer_check:=false;πend;ππfunction async_init_fossil: boolean;πvarπ regs: registers;πbegin;π regs.ah:=4;π regs.bx:=0;π regs.dx:=port_num;π intr($14,regs);π if regs.ax=$1954 then async_init_fossil:=true else async_init_fossil:=false;πend;ππprocedure async_deinit_fossil;πvarπ regs: registers;πbegin;π regs.ah:=5;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_set_dtr(state: boolean);πvarπ regs: registers;πbegin;π regs.ah:=6;π if state then regs.al:=1 else regs.al:=0;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_flush_output;πvarπ regs: registers;πbegin;π regs.ah:=8;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_purge_output;πvarπ regs: registers;πbegin;π regs.ah:=9;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_purge_input;πvarπ regs: registers;πbegin;π regs.ah:=$0a;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_watchdog_on;πvarπ regs: registers;πbegin;π regs.ah:=$14;π regs.al:=01;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_watchdog_off;πvarπ regs: registers;πbegin;π regs.ah:=$14;π regs.al:=00;π regs.dx:=port_num;π intr($14,regs);πend;ππprocedure async_warm_reboot;πvarπ regs: registers;πbegin;π regs.ah:=$17;π regs.al:=01;π intr($14,regs);πend;ππprocedure async_cold_reboot;πvarπ regs: registers;πbegin;π regs.ah:=$17;π regs.al:=00;π intr($14,regs);πend;ππprocedure async_set_baud(n: integer);πvarπ regs: registers;πbegin;π regs.ah:=00;π regs.al:=3;π regs.dx:=port_num;π case n ofπ 300: regs.al:=regs.al or $40;π 1200: regs.al:=regs.al or $80;π 2400: regs.al:=regs.al or $A0;π 4800: regs.al:=regs.al or $C0;π 9600: regs.al:=regs.al or $E0;π 19200: regs.al:=regs.al or $00;π end;π intr($14,regs);πend;ππprocedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);πvarπ regs: registers;πbegin;π regs.ah:=$0F;π regs.al:=00;π if softtran then regs.al:=regs.al or $01;π if Hard then regs.al:=regs.al or $02;π if SoftRecv then regs.al:=regs.al or $08;π regs.al:=regs.al or $F0;π Intr($14,regs);πend;ππprocedure async_get_fossil_data;πvarπ regs: registers;πbegin;π regs.ah:=$1B;π regs.cx:=sizeof(fossildata);π regs.dx:=port_num;π regs.es:=seg(fossildata);π regs.di:=ofs(fossildata);π intr($14,regs);πend;ππprocedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);πbegin;π async_get_fossil_data;π insize:=fossildata.ibufr;π infree:=fossildata.ifree;π outsize:=fossildata.obufr;π outfree:=fossildata.ofree;πend;ππend.π 46 08-24-9413:21ALL WIM VAN DER VEGT Windows ASYNC unit SWAG9408 2╢ \ 468 ╣J {---------------------------------------------------------}π{ Project : Async12 for Windows }π{ By : Ir. G.W van der Vegt }π{---------------------------------------------------------}π{ Based on the following TP product : }π{ }π{ ASYNC12 - Interrupt-driven asyncronous }π{ communications for Turbo Pascal. }π{ }π{ Version 1.2 - Wedensday June 14, 1989 }π{ Copyright (C) 1989, Rising Edge Data Services}π{ }π{ Permission is granted for non-commercial }π{ use and distribution. }π{ }π{ Author : Mark Schultz }π{ }π{---------------------------------------------------------}π{ }π{ -Because of the complex nature of serial I/O not all }π{ routines are 100% tested. I don't feel/am/will ever be }π{ responsible for any damage caused by this routines. }π{ }π{ -Some routines don't work (yet) because some fields are }π{ mentioned in the BP7 help file but are missing in }π{ Wintypes. The routines are SetCTSmode, SetRTSMode & }π{ SoftHandshake. }π{ }π{ -Some routines can't be implemented in windows. They }π{ are listed behind the end. }π{ }π{ -From the original ASYNC12 code, only the syntax, some }π{ high level pascal code and pieces of comment are used. }π{ Due to the different way windows handels devices, all }π{ assembly codes couldn't be reused and was rewritten in }π{ Borland Pascal. I used parts of ASYNC12 because I find }π{ it a very complete package for Serial I/O and it works }π{ very well too. Sources were supplied and documented }π{ very well. }π{ }π{---------------------------------------------------------}π{ Date .Time Revision }π{ ------- ---- ---------------------------------------- }π{ 9406017.1200 Creation. }π{---------------------------------------------------------}ππLibrary Async12w;ππUsesπ Winprocs,π Wintypes;ππ{****************************************************************************}ππ{----Public definition section}ππTYPEπ T_eoln = (C_cr,C_lf);ππCONSTπ C_MaxCom = 4; {----Supports COM1..COM4}π C_MinBaud = 110;π C_MaxBaud = 256000;ππTYPEπ C_ports = 1..C_MaxCom; {----Subrange type to minimize programming errors}ππ{****************************************************************************}ππ{----Private definition section}ππCONSTπ portopen : Array[C_ports] OF Boolean = (false,false,false,false); {----Open port flags }π cids : ARRAY[C_ports] OF Integer = (-1,-1,-1,-1); {----Device ID's }π inbs : ARRAY[C_ports] OF Word = ( 0, 0, 0, 0); {----Input buffer sizes}π outbs : ARRAY[C_ports] OF Word = ( 0, 0, 0, 0); {----Output buffer sizes}π txdir = 0; {----Used for FlushCom }π rxdir = 1; {----Used for FlushCom }π fon = 1; {----Used for Handshakes}π foff = 0; {----Used for Handshakes}π eolns : ARRAY[C_ports] OF T_eoln = (C_cr,C_cr,C_cr,C_cr); {----Eoln characters }ππVARπ{----Don't seem to be declared in Wintypes, neccesary to fake}π foutx,π foutxCTSflow,π fRTSflow : Byte;ππ{****************************************************************************}π{* *}π{* Procedure ComReadCh(ComPort:Byte) : Char; External; *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* *}π{* Returns character from input buffer of specified port. If the buffer *}π{* is empty, the port # invalid or not opened, a Chr(0) is returned. *}π{* *}π{****************************************************************************}ππFunction ComReadCh(comport:C_ports) : Char; Export;ππVarπ stat : TComStat;π ch : Char;π cid : Integer;ππBeginπ ComReadCh:=#0;ππ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ {----See how many characters are in the rx buffer}π If (GetCommError(cid,stat)=0) ANDπ (stat.cbInQue>0) ANDπ (ReadComm(cid,@ch,1)=1)π THEN ComReadCh:=ch;π End;πEND; {of ComReadCh}ππ{****************************************************************************}π{* *}π{* Function ComReadChW(ComPort:Byte) : Char; External; *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* *}π{* Works like ComReadCh, but will wait until at least 1 character is *}π{* present in the specified input buffer before exiting. Thus, ComReadChW *}π{* works much like the ReadKey predefined function. *}π{* *}π{****************************************************************************}ππFunction ComReadChW(comport:C_ports) : Char; Export;ππVarπ stat : TComStat;π ch : Char;π ok : Boolean;π cid : Integer;ππBeginπ ComReadChW:=#00;ππ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];π ok :=false;ππ {----See how many characters are in the rx buffer}π REPEATπ IF (GetCommError(cid,stat)<>0)π THEN ok:=Trueπ ELSEπ BEGINπ IF (stat.cbInQue<>0) ANDπ (ReadComm(cid,@ch,1)=1)π THEN ComReadChW:=ch;π ok:=true;π END;π UNTIL ok;π End;πEND; {of ComReadChW}ππ{****************************************************************************}π{* *}π{* Procedure ComWriteCh(ComPort:Byte; Ch:Char); External *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Ch:Char -> Character to send *}π{* *}π{* Places the character [Ch] in the transmit buffer of the specified port. *}π{* If the port specified is not open or nonexistent, or if the buffer is *}π{* filled, the character is discarded. *}π{* *}π{****************************************************************************}ππProcedure ComWriteCh(comport:C_ports; Ch:Char); Export;ππVARπ stat : TComStat;π cid : Integer;ππBEGINπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ IF (GetCommError(cid,stat)=0) ANDπ (stat.cbOutQue<outbs[comport])π THEN TransmitCommChar(cid,ch);π End;πEND; {of CommWriteCh}ππ{****************************************************************************}π{* *}π{* Procedure ComWriteChW(ComPort:Byte; Ch:Char); External; *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Ch:Char -> Character to send *}π{* *}π{* Works as ComWriteCh, but will wait until at least 1 free position is *}π{* available in the output buffer before attempting to place the character *}π{* [Ch] in it. Allows the programmer to send characters without regard to *}π{* available buffer space. *}π{* *}π{****************************************************************************}ππProcedure ComWriteChW(comport:C_ports; Ch:Char); Export;ππVARπ stat : TComStat;π cid : Integer;π rdy : Boolean;ππBEGINπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];π rdy:=False;ππ REPEATπ IF (GetCommError(cid,stat)<>0)π THEN rdy:=trueπ ELSEπ IF (stat.cbOutQue<outbs[comport])π THEN rdy:=TransmitCommChar(cid,ch)=0;π UNTIL rdy;π End;πEnd; {of ComWriteChW}ππ{****************************************************************************}π{* *}π{* Procedure ClearCom(ComPort:Byte); IO:Char) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Request ignored if out of range or unopened. *}π{* IO:Char -> Action code; I=Input, O=Output, B=Both *}π{* No action taken if action code unrecognized. *}π{* *}π{* ClearCom allows the user to completely clear the contents of either *}π{* the input (receive) and/or output (transmit) buffers. The "action *}π{* code" passed in <IO> determines if the input (I) or output (O) buffer *}π{* is cleared. Action code (B) will clear both buffers. This is useful *}π{* if you wish to cancel a transmitted message or ignore part of a *}π{* received message. *}π{* *}π{****************************************************************************}ππProcedure ClearCom(ComPort:C_Ports;IO:Char); Export;ππVarπ cid : Integer;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ Case Upcase(IO) OFπ 'I' : FlushComm(cid,rxdir);π 'B' : Beginπ FlushComm(cid,rxdir);π FlushComm(cid,txdir);π End;π 'O' : FlushComm(cid,txdir);π End;π End;πEnd; {of ClearComm}ππ{****************************************************************************}π{* *}π{* Procedure ComBufferLeft(ComPort:Byte; IO:Char) : Word *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Returns 0 if Port # invalid or unopened. *}π{* IO:Char -> Action code; I=Input, O=Output *}π{* Returns 0 if action code unrecognized. *}π{* *}π{* ComBufferLeft will return a number (bytes) indicating how much space *}π{* remains in the selected buffer. The INPUT buffer is checked if <IO> is *}π{* (I), and the output buffer is interrogated when <IO> is (O). Any other *}π{* "action code" will return a result of 0. Use this function when it is *}π{* important to avoid program delays due to calls to output procedures or *}π{* to prioritize the reception of data (to prevent overflows). *}π{* *}π{****************************************************************************}ππFunction ComBufferLeft(ComPort:C_ports; IO:Char) : Word; Export;ππVARπ stat : TComStat;π cid : Integer;ππBeginπ ComBufferLeft := 0;ππ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ IF (GetCommError(cid,stat)=0)π THENπ CASE Upcase(IO) OFπ 'I' : ComBufferLeft:=inbs [comport]-stat.cbInQue;π 'O' : ComBufferLeft:=outbs[comport]-stat.cbOutQue;π END;π End;πEnd; {ComBufferLeft}ππ{****************************************************************************}π{* *}π{* Procedure ComWaitForClear(ComPort:Byte) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Exits immediately if out of range or port unopened. *}π{* *}π{* A call to ComWaitForClear will stop processing until the selected out- *}π{* put buffer is completely emptied. Typically used just before a call *}π{* to the CloseCom procedure to prevent premature cut-off of messages in *}π{* transit. *}π{* *}π{****************************************************************************}ππProcedure ComWaitForClear(ComPort:C_ports); Export;ππVarπ stat : TComStat;π cid : Integer;π Empty : Boolean;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid :=cids[comport];π empty:=false;ππ REPEATπ IF (GetCommError(cid,stat)<>0)π THEN empty:=trueπ ELSE empty:=stat.cbOutQue=0π UNTIL empty;π End;πEnd; {ComWaitForClear}ππ{****************************************************************************}π{* *}π{* Procedure ComWrite(ComPort:Byte; St:String) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Exits immediately if out of range or port unopened. *}π{* St:String -> String to send *}π{* *}π{* Sends string <St> out communications port <ComPort>. *}π{* *}π{****************************************************************************}ππProcedure ComWrite(ComPort:C_ports; St:String); Export;ππVarπ X : Byte;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ For X := 1 To Length(St) Doπ ComWriteChW(ComPort,St[X]);πEnd; {of ComWrite}ππ{****************************************************************************}π{* *}π{* Procedure ComWriteln(ComPort:Byte; St:String); *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Exits immediately if out of range or port unopened. *}π{* St:String -> String to send *}π{* *}π{* Sends string <St> with a CR and LF appended. *}π{* *}π{****************************************************************************}ππProcedure ComWriteln(ComPort:C_ports; St:String); Export;ππVarπ X : Byte;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ For X := 1 To Length(St) Doπ ComWriteChW(ComPort,St[X]);π ComWriteChW(ComPort,#13);π ComWriteChW(ComPort,#10);π End;πEnd; {of ComWriteln}ππ{****************************************************************************}π{* *}π{* Procedure Delay(ms:word); *}π{* *}π{* ms:word -> Number of msec to wait. *}π{* *}π{* A substitute for CRT's Delay under DOS. This one will wait for at least *}π{* the amount of msec specified, probably even more because of the task- *)π{* switching nature of Windows. So a msec can end up as a second if ALT-TAB*}π{* or something like is pressed. Minumum delays are guaranteed independend *}π{* of task-switches. *}π{* *}π{****************************************************************************}ππProcedure Delay(ms : Word);ππVarπ theend,π marker : Longint;ππBeginπ{----Potentional overflow if windows runs for 49 days without a stop}π marker:=GetTickCount;π{$R-}π theend:=Longint(marker+ms);π{$R+}ππ{----First see if timer overrun will occure and wait for this,π then test as usual}π If (theend<marker)π Thenπ While (GetTickCount>=0) DO;ππ{----Wait for projected time to pass}π While (theend>=GettickCount) Do;πEnd; {of Delay}ππ{****************************************************************************}π{* *}π{* Procedure ComWriteWithDelay(ComPort:Byte; St:String; Dly:Word); *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Exits immediately if out of range or port unopened. *}π{* St:String -> String to send *}π{* Dly:Word -> Time, in milliseconds, to delay between each char. *}π{* *}π{* ComWriteWithDelay will send string <St> to port <ComPort>, delaying *}π{* for <Dly> milliseconds between each character. Useful for systems that *}π{* cannot keep up with transmissions sent at full speed. *}π{* *}π{****************************************************************************}ππProcedure ComWriteWithDelay(ComPort:C_ports; St:String; Dly:Word); Export;ππVarπ X : Byte;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ ComWaitForClear(ComPort);π For X := 1 To Length(St) Doπ Beginπ ComWriteChW(ComPort,St[X]);π ComWaitForClear(ComPort);π Delay(dly);π End;π End;πEnd; {of ComWriteWithDelay}ππ{****************************************************************************}π{* *}π{* Procedure ComReadln(ComPort:Byte; Var St:String; Size:Byte; Echo:Boolean)*}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Exits immediately if out of range or port unopened. *}π{* St:String <- Edited string from remote *}π{* Size:Byte; -> Maximum allowable length of input *}π{* Echo:Boolean; -> Set TRUE to echo received characters *}π{* *}π{* ComReadln is the remote equivalent of the standard Pascal READLN pro- *}π{* cedure with some enhancements. ComReadln will accept an entry of up to *}π{* 40 printable ASCII characters, supporting ^H and ^X editing commands. *}π{* Echo-back of the entry (for full-duplex operation) is optional. All *}π{* control characters, as well as non-ASCII (8th bit set) characters are *}π{* stripped. If <Echo> is enabled, ASCII BEL (^G) characters are sent *}π{* when erroneous characters are intercepted. Upon receipt of a ^M (CR), *}π{* the procedure is terminated and the final string result returned. *}π{* *}π{****************************************************************************}ππProcedure ComReadln(ComPort:C_ports; Var St:String; Size:Byte; Echo:Boolean); Export;ππVarπ Len,X : Byte;π Ch : Char;π Done : Boolean;ππBeginπ St:='';π If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ Done := False;π Repeatπ Len:=Length(St);π Ch :=Chr(Ord(ComReadChW(ComPort)) And $7F);ππ Case Ch Ofπ ^H : If Len>0π Thenπ Beginπ Dec(Len);π St[0]:=Chr(Len);π If Echo Then ComWrite(ComPort,#8#32#8);π Endπ Else ComWriteChW(ComPort,^G);π ^J : If eolns[comport]=C_lfπ Thenπ Beginπ Done:=True;π If Echo Then ComWrite(ComPort,#13#10);π End;π ^M : If eolns[comport]=C_crπ Thenπ Beginπ Done:=True;π If Echo Then ComWrite(ComPort,#13#10);π End;π ^X : Beginπ St:='';π If Len=0 Then ComWriteCh(ComPort,^G);π If Echoπ Thenπ For X:=1 to Len Doπ ComWrite(ComPort,#8#32#8);π End;π #32..π #127 : If Len<Sizeπ Thenπ Beginπ Inc(Len);π St[Len]:=Ch;π St[0]:=Chr(Len);π If Echo Then ComWriteChW(ComPort,Ch);π Endπ Elseπ If Echo Then ComWriteChW(ComPort,^G);π Elseπ If Echo Then ComWriteChW(ComPort,^G)π End;π Until Done;π End;πEnd; {of ComReadln}ππ{****************************************************************************}π{* *}π{* Procedure SetRTSMode(ComPort:Byte; Mode:Boolean; RTSOn,RTSOff:Word) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Request ignored if out of range or unopened. *}π{* Mode:Boolean -> TRUE to enable automatic RTS handshake *}π{* RTSOn:Word -> Buffer-usage point at which the RTS line is asserted *}π{* RTSOff:Word -> Buffer-usage point at which the RTS line is dropped *}π{* *}π{* SetRTSMode enables or disables automated RTS handshaking. If [MODE] is *}π{* TRUE, automated RTS handshaking is enabled. If enabled, the RTS line *}π{* will be DROPPED when the # of buffer bytes used reaches or exceeds that *}π{* of [RTSOff]. The RTS line will then be re-asserted when the buffer is *}π{* emptied down to the [RTSOn] usage point. If either [RTSOn] or [RTSOff] *}π{* exceeds the input buffer size, they will be forced to (buffersize-1). *}π{* If [RTSOn] > [RTSOff] then [RTSOn] will be the same as [RTSOff]. *}π{* The actual handshaking control is located in the interrupt driver for *}π{* the port (see ASYNC12.ASM). *}π{* *}π{****************************************************************************}ππProcedure SetRTSmode(ComPort:C_ports; Mode:Boolean; RTSOn,RTSOff:Word); Export;ππVarπ dcb : tdcb;π cid : Integer;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ If GetCommState(cid,dcb)=0π Thenπ Beginπ With dcb Doπ Case mode ofπ True : Beginπ fRTSflow:=fon;π Xonlim :=inbs[comport]-RTSon ;π Xofflim :=inbs[comport]-RTSoff;π End;π False : Beginπ fRTSflow:=foff;π End;π End;π SetCommState(dcb);π End;π End;πEnd; {of SetRTSmode}ππ{****************************************************************************}π{* *}π{* Procedure SetCTSMode(ComPort:Byte; Mode:Boolean) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Request ignored if out of range or unopened. *}π{* Mode:Boolean -> Set to TRUE to enable automatic CTS handshake. *}π{* *}π{* SetCTSMode allows the enabling or disabling of automated CTS handshak- *}π{* ing. If [Mode] is TRUE, CTS handshaking is enabled, which means that *}π{* if the remote drops the CTS line, the transmitter will be disabled *}π{* until the CTS line is asserted again. Automatic handshake is disabled *}π{* if [Mode] is FALSE. CTS handshaking and "software" handshaking (pro- *}π{* vided by the SoftHandshake procedure) ARE compatable and may be used *}π{* in any combination. *}π{* *}π{****************************************************************************}ππProcedure SetCTSMode(ComPort:Byte; Mode:Boolean); Export;ππVarπ dcb : tdcb;π cid : Integer;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ If GetCommState(cid,dcb)=0π Thenπ Beginπ Case mode ofπ True : foutxCTSflow:=fon;π False : foutxCTSflow:=foff;π End;π SetCommState(dcb);π End;π End;πEnd; {of SetCTSmode}ππ{****************************************************************************}π{* *}π{* Procedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom). *}π{* Request ignored if out of range or unopened. *}π{* Mode:Boolean -> Set to TRUE to enable transmit software handshake *}π{* Start:Char -> START control character (usually ^Q) *}π{* Defaults to ^Q if character passed is >= <Space> *}π{* Stop:Char -> STOP control character (usually ^S) *}π{* Defaults to ^S if character passed is >= <Space> *}π{* *}π{* SoftHandshake controls the usage of "Software" (control-character) *}π{* handshaking on transmission. If "software handshake" is enabled *}π{* ([Mode] is TRUE), transmission will be halted if the character in *}π{* [Stop] is received. Transmission is re-enabled if the [Start] char- *}π{* acter is received. Both the [Start] and [Stop] characters MUST be *}π{* CONTROL characters (i.e. Ord(Start) and Ord(Stop) must both be < 32). *}π{* Also, <Start> and <Stop> CANNOT be the same character. If either one *}π{* of these restrictions are violated, the defaults (^Q for <Start> and ^S *}π{* for <Stop>) will be used. *}π{* *}π{****************************************************************************}ππProcedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char); Export;ππVarπ dcb : tdcb;π cid : integer;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ If GetCommState(cid,dcb)=0π Thenπ Beginπ Case mode ofπ True : Beginπ foutx:=fon;π If (start IN [#00..#31]) And (start<>stop)π Then dcb.Xonchar:=startπ Else dcb.Xonchar:=^Q;π If (stop IN [#00..#31]) And (start<>stop)π Then dcb.Xoffchar:=stopπ Else dcb.Xoffchar:=^S;π End;π False : foutx:=foff;π End;π SetCommState(dcb);π End;π End;πEnd; {of Softhandshake}ππ{****************************************************************************}π{* *}π{* Function ComExist(ComPort:Byte) : Boolean *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Returns FALSE if out of range *}π{* Returns TRUE if hardware for selected port is detected & tests OK *}π{* *}π{****************************************************************************}ππFunction ComExist(ComPort:C_ports) : Boolean; Export;ππVARπ mode : String;π dcb : tdcb;ππBeginπ If (ComPort IN [1..C_MaxCom])π Thenπ Beginπ mode:='COM'+Chr(Comport+Ord('0'))+' 19200,N,8,1'#0;π ComExist:=(BuildCommDCB(@mode[1],dcb)=0);π Endπ Else ComExist:=false;πEnd; {of Comexist}ππ{****************************************************************************}π{* *}π{* Function ComTrueBaud(Baud:Longint) : Real *}π{* *}π{* Baud:Longint -> User baud rate to test. *}π{* Should be between C_MinBaud and C_MaxBaud. *}π{* Returns the actual baud rate based on the accuracy of the 8250 divider. *}π{* *}π{* The ASYNC12 communications package allows the programmer to select ANY *}π{* baud rate, not just those that are predefined by the BIOS or other *}π{* agency. Since the 8250 uses a divider/counter chain to generate it's *}π{* baud clock, many non-standard baud rates can be generated. However, *}π{* the binary counter/divider is not always capable of generating the *}π{* EXACT baud rate desired by a user. This function, when passed a valid *}π{* baud rate, will return the ACTUAL baud rate that will be generated. *}π{* The baud rate is based on a 8250 input clock rate of 1.73728 MHz. *}π{* *}π{****************************************************************************}ππFunction ComTrueBaud(Baud:Longint) : Real; Export;ππVarπ X : Real;π Y : Word;ππBeginπ X := Baud;π If X < C_MinBaud Then X := C_MinBaud;π If X > C_MaxBaud Then X := C_MaxBaud;π ComTrueBaud := C_MaxBaud / Round($900/(X/50));πEnd; {of ComTrueBaud}ππ{****************************************************************************}π{* *}π{* Function Lstr(l : Longint) : String; *}π{* *}π{* l:Longint -> Number converted to a string *}π{* *}π{* This function converts longint l to a string. *}π{* *}π{****************************************************************************}ππFunction Lstr(l : Longint) : String;ππVarπ s : String;ππBeginπ Str(l:0,s);π Lstr:=s;πEnd; {of Lstr}ππ{****************************************************************************}π{* *}π{* Procedure ComParams(ComPort:Byte; Baud:Longint; *}π{* WordSize:Byte; Parity:Char; StopBits:Byte); *}π{* *}π{* ComPort:Byte -> Port # to initialize. Must be (1 - C_MaxCom) *}π{* Procedure aborted if port # invalid or unopened. *}π{* Baud:Longint -> Desired baud rate. Should be (C_MinBaud - C_MaxBaud)*}π{* C_MinBaud or C_MaxBaud used if out of range. *}π{* WordSize:Byte -> Word size, in bits. Must be 5 - 8 bits. *}π{* 8-bit word used if out of range. *}π{* Parity:Char -> Parity classification. *}π{* May be N)one, E)ven, O)dd, M)ark or S)pace. *}π{* N)one selected if classification unknown. *}π{* StopBits:Byte -> # of stop bits to pad character with. Range (1-2) *}π{* 1 stop bit used if out of range. *}π{* *}π{* ComParams is used to configure an OPEN'ed port for the desired comm- *}π{* unications parameters, namely baud rate, word size, parity form and *}π{* # of stop bits. A call to this procedure will set up the port approp- *}π{* riately, as well as assert the DTR, RTS and OUT2 control lines and *}π{* clear all buffers. *}π{* *}π{****************************************************************************}ππProcedure ComParams(ComPort:C_ports; Baud:LongInt; WordSize:Byte; Parity:Char; StopBits:Byte); Export;ππVarπ mode : String;π cid : Integer;π dcb : tdcb;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];ππ {----Like COM1 9600,N,8,1}π mode:='COM'+Chr(Comport+Ord('0'))+' '+Lstr(baud)+','+Upcase(Parity)+','+Lstr(Wordsize)+','+Lstr(stopbits)+#0;π IF (BuildCommDCB(@mode[1],dcb)=0)π Thenπ Beginπ dcb.id:=cid;π SetCommState(dcb);π End;π End;πEnd; {of ComParams}ππ{****************************************************************************}π{* *}π{* Function OpenCom(ComPort:Byte; InBufferSize,OutBufferSize:Word):Boolean *}π{* *}π{* ComPort:Byte -> Port # to OPEN (1 - C_MaxCom) *}π{* Request will fail if out of range or port OPEN *}π{* InBufferSize:Word -> Requested size of input (receive) buffer *}π{* OutBufferSize:Word -> Requested size of output (transmit) buffer *}π{* Returns success/fail status of OPEN request (TRUE if OPEN successful) *}π{* *}π{* OpenCom must be called before any activity (other than existence check, *}π{* see the ComExist function) takes place. OpenCom initializes the *}π{* interrupt drivers and serial communications hardware for the selected *}π{* port, preparing it for I/O. Once a port has been OPENed, a call to *}π{* ComParams should be made to set up communications parameters (baud rate,*}π{* parity and the like). Once this is done, I/O can take place on the *}π{* port. OpenCom will return a TRUE value if the opening procedure was *}π{* successful, or FALSE if it is not. *}π{* *}π{****************************************************************************}ππFunction OpenCom(ComPort:C_ports; InBufferSize,OutBufferSize:Word) : Boolean; Export;ππVarπ cid : Integer;π comp : String;ππBeginπ OpenCom := False;π If (ComPort IN [1..C_MaxCom]) Andπ Not(portopen[ComPort]) Andπ ComExist(comport)π Thenπ Beginπ comp:='COM'+Chr(comport+Ord('0'))+#0;π cid:=OpenComm(@comp[1],InBufferSize,OutBufferSize);π If (cid>=0)π Thenπ Beginπ cids [comport] :=cid;π inbs [comport] :=InBufferSize;π outbs[comport] :=OutBufferSize;π portopen[comport]:=true;π End;π OpenCom:=(cid>=0);π End;πEnd; {of OpenCom}ππ{****************************************************************************}π{* *}π{* Procedure CloseCom(ComPort:Byte) *}π{* *}π{* ComPort:Byte -> Port # to close *}π{* Request ignored if port closed or out of range. *}π{* *}π{* CloseCom will un-link the interrupt drivers for a port, deallocate it's *}π{* buffers and drop the DTR and RTS signal lines for a port opened with *}π{* the OpenCom function. It should be called before exiting your program *}π{* to ensure that the port is properly shut down. *}π{* NOTE: CloseCom shuts down a communications channel IMMEDIATELY, *}π{* even if there is data present in the input or output buffers. *}π{* Therefore, you may wish to call the ComWaitForClear procedure *}π{* before closing the ports. *}π{* *}π{****************************************************************************}ππProcedure CloseCom(ComPort:C_ports); Export;ππVarπ cid : integer;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ Beginπ cid:=cids[comport];π portopen[comport]:=Not(CloseComm(cid)=0);π End;πEnd; {of CloseCom}ππ{****************************************************************************}π{* *}π{* Procedure CloseAllComs *}π{* *}π{* CloseAllComs will CLOSE all currently OPENed ports. See the CloseCom *}π{* procedure description for more details. *}π{* *}π{****************************************************************************}ππProcedure CloseAllComs; Export;ππVarπ X : C_ports;ππBeginπ For X := 1 To C_MaxCom Doπ If portopen[X] Then CloseCom(X);πEnd; {of CloseAllComs}ππ{****************************************************************************}π{* *}π{* Procedure ComSetEoln(ComPort:C_ports;EolnCh : T_eoln) *}π{* *}π{* ComPort:Byte -> Port # for which to alter the eoln character *}π{* Request ignored if port closed or out of range. *}π{* EolnCh:T_eoln -> Eoln character needed *}π{* *}π{* With this function one can toggle the eoln character between cr and lf. *}π{* *}π{****************************************************************************}ππProcedure ComSetEoln(ComPort:C_ports;EolnCh : T_eoln); Export;ππBeginπ If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Then eolns[comport]:=EolnCh;πEnd; {of ComSetEoln}ππ{****************************************************************************}π{* *}π{* Function ComGetBufsize(ComPort:C_ports;IO : char) *}π{* *}π{* ComPort:Byte -> Port # for which to retrieve the buffersize *}π{* Request ignored if port closed or out of range. *}π{* IO:Char -> Action code; I=Input, O=Output *}π{* Returns 0 if action code unrecognized. *}π{* *}π{* This function will return the buffer size defined for a serial port. *}π{* *}π{****************************************************************************}ππFunction ComGetBufsize(ComPort:C_ports;IO : Char) : WORD; Export;ππBeginπ ComGetBufSize:=0;π If (ComPort IN [1..C_MaxCom]) Andπ (portopen[ComPort])π Thenπ CASE Upcase(IO) OFπ 'I' : ComgetBufSize:=inbs [comport];π 'O' : ComgetBufSize:=outbs[comport];π END;πEnd; {of ComGetBufferSize}ππ{****************************************************************************}ππExportsπ ComReadCh index 1,π ComReadChW index 2,π ComWriteCh index 3,π ComWriteChW index 4,π ClearCom index 5,π ComBufferLeft index 6,π ComWaitForClear index 7,π ComWrite index 8,π ComWriteln index 9,π ComWriteWithDelay index 10,π ComReadln index 11,π SetRTSmode index 12,π SetCTSMode index 13,π SoftHandshake index 14,π ComExist index 15,π ComTrueBaud index 16,π ComParams index 17,π OpenCom index 18,π CloseCom index 19,π CloseAllComs index 20,π ComSetEoln index 21,π ComGetBufSize index 22;ππBeginπEnd.ππ{----The following procedures/functions from the async12 }π{ package are not available }ππ{****************************************************************************}π{* *}π{* Procedure SetDTR(ComPort:Byte; Assert:Boolean); *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* Assert:Boolean -> DTR assertion flag (TRUE to assert DTR) *}π{* *}π{* Provides a means to control the port's DTR (Data Terminal Ready) signal *}π{* line. When [Assert] is TRUE, the DTR line is placed in the "active" *}π{* state, signalling to a remote system that the host is "on-line" *}π{* (although not nessesarily ready to receive data - see SetRTS). *}π{* *}π{****************************************************************************}ππProcedure SetDTR(ComPort:Byte; Assert:Boolean);ππBeginπEnd; {of SetDTR}ππ{****************************************************************************}π{* *}π{* Procedure SetRTS(ComPort:Byte; Assert:Boolean) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* Assert:Boolean -> RTS assertion flag (Set TRUE to assert RTS) *}π{* *}π{* SetRTS allows a program to manually control the Request-To-Send (RTS) *}π{* signal line. If RTS handshaking is disabled (see C_Ctrl definition *}π{* and the the SetRTSMode procedure), this procedure may be used. SetRTS *}π{* should NOT be used if RTS handshaking is enabled. *}π{* *}π{****************************************************************************}ππProcedure SetRTS(ComPort:Byte; Assert:Boolean);ππBeginπEnd; {of SetRTS}ππ{****************************************************************************}π{* *}π{* Procedure SetOUT1(ComPort:Byte; Assert:Boolean) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* Assert:Boolean -> OUT1 assertion flag (set TRUE to assert OUT1 line) *}π{* *}π{* SetOUT1 is provided for reasons of completeness only, since the *}π{* standard PC/XT/AT configurations do not utilize this control signal. *}π{* If [Assert] is TRUE, the OUT1 signal line on the 8250 will be set to a *}π{* LOW logic level (inverted logic). The OUT1 signal is present on pin 34 *}π{* of the 8250 (but not on the port itself). *}π{* *}π{****************************************************************************}ππProcedure SetOUT1(ComPort:Byte; Assert:Boolean);ππBeginπEnd; {of SetOUT1}ππ{****************************************************************************}π{* *}π{* Procedure SetOUT2(ComPort:Byte; Assert:Boolean) *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* Assert:Boolean -> OUT2 assertion flag (set TRUE to assert OUT2 line) *}π{* *}π{* The OUT2 signal line, although not available on the port itself, is *}π{* used to gate the 8250 <INTRPT> (interrupt) line and thus acts as a *}π{* redundant means of controlling 8250 interrupts. When [Assert] is TRUE, *}π{* the /OUT2 line on the 8250 is lowered, which allows the passage of the *}π{* <INTRPT> signal through a gating arrangement, allowing the 8250 to *}π{* generate interrupts. Int's can be disabled bu unASSERTing this line. *}π{* *}π{****************************************************************************}ππProcedure SetOUT2(ComPort:Byte; Assert:Boolean);ππBeginπEnd; {of SetOUT2}ππ{****************************************************************************}π{* *}π{* Function CTSStat(ComPort:Byte) : Boolean *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* Returns status of Clear-To-Send line (TRUE if CTS asserted) *}π{* *}π{* CTSStat provides a means to interrogate the Clear-To-Send hardware *}π{* handshaking line. In a typical arrangement, when CTS is asserted, this *}π{* signals the host (this computer) that the receiver is ready to accept *}π{* data (in contrast to the DSR line, which signals the receiver as *}π{* on-line but not nessesarily ready to accept data). An automated mech- *}π{* ansim (see CTSMode) is provided to do this, but in cases where this is *}π{* undesirable or inappropriate, the CTSStat function can be used to int- *}π{* terrogate this line manually. *}π{* *}π{****************************************************************************}ππFunction CTSStat(ComPort:Byte) : Boolean;ππBeginπEnd; {of CTSstat}ππ{****************************************************************************}π{* *}π{* Function DSRStat(ComPort:Byte) : Boolean *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* Returns status of Data Set Ready (DSR) signal line. *}π{* *}π{* The Data Set Ready (DSR) line is typically used by a remote station *}π{* to signal the host system that it is on-line (although not nessesarily *}π{* ready to receive data yet - see CTSStat). A remote station has the DSR *}π{* line asserted if DSRStat returns TRUE. *}π{* *}π{****************************************************************************}ππFunction DSRStat(ComPort:Byte) : Boolean;ππBeginπEnd; {of DSRstat}ππ{****************************************************************************}π{* *}π{* Function RIStat(ComPort:Byte) : Boolean *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* *}π{* Returns the status of the Ring Indicator (RI) line. This line is *}π{* typically used only by modems, and indicates that the modem has detect- *}π{* ed an incoming call if RIStat returns TRUE. *}π{* *}π{****************************************************************************}ππFunction RIStat(ComPort:Byte) : Boolean;ππBeginπEnd; {of RIstat}ππ{****************************************************************************}π{* *}π{* Function DCDStat(ComPort:Byte) : Boolean *}π{* *}π{* ComPort:Byte -> Port # to use (1 - C_MaxCom) *}π{* Call ignored if out-of-range *}π{* *}π{* Returns the status of the Data Carrier Detect (DCD) line from the rem- *}π{* ote device, typically a modem. When asserted (DCDStat returns TRUE), *}π{* the modem indicates that it has successfuly linked with another modem *}π{* device at another site. *}π{* *}π{****************************************************************************}ππFunction DCDStat(ComPort:Byte) : Boolean;ππBeginπEnd; {of DCDstat}ππ{ --------------- WINDOWS INTERFACE UNIT -------------------- }ππUnit WinAsync;ππInterfaceππCONSTπ C_MaxCom = 4; {----supports COM1..COM4 }π C_MinBaud = 110; {----min baudrate supported by windows 3.1 }π C_MaxBaud = 256000; {----max baudrate supported by windows 3.1 }ππTYPEπ T_eoln = (C_cr,C_lf); {----used to change EOLN character from cr to lf}π C_ports = 1..C_MaxCom; {----subrange type to minimize programming errors}πππFunction ComReadCh(comport:C_ports) : Char;πFunction ComReadChW(comport:C_ports) : Char;πProcedure ComReadln(ComPort:C_ports; Var St:String; Size:Byte; Echo:Boolean);ππProcedure ComWriteCh(comport:C_ports; Ch:Char);πProcedure ComWriteChW(comport:C_ports; Ch:Char);πProcedure ComWrite(ComPort:C_ports; St:String);πProcedure ComWriteln(ComPort:C_ports; St:String);πProcedure ComWriteWithDelay(ComPort:C_ports; St:String; Dly:Word);ππProcedure ClearCom(ComPort:C_Ports;IO:Char);πFunction ComBufferLeft(ComPort:C_ports; IO:Char) : Word;πProcedure ComWaitForClear(ComPort:C_ports);ππProcedure SetRTSmode(ComPort:C_ports; Mode:Boolean; RTSOn,RTSOff:Word);πProcedure SetCTSMode(ComPort:Byte; Mode:Boolean);πProcedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char);ππFunction ComExist(ComPort:C_ports) : Boolean;πProcedure ComParams(ComPort:C_ports; Baud:LongInt; WordSize:Byte; Parity:Char; StopBits:Byte);πFunction ComTrueBaud(Baud:Longint) : Real;πFunction OpenCom(ComPort:C_ports; InBufferSize,OutBufferSize:Word) : Boolean;ππProcedure CloseCom(ComPort:C_ports);πProcedure CloseAllComs;πProcedure ComSetEoln(ComPort:C_ports;EolnCh : T_eoln);ππFunction ComGetBufsize(ComPort:C_ports;IO : Char) : WORD;ππImplementationππFunction ComReadCh(comport:C_ports) : Char; external 'async12w';πFunction ComReadChW(comport:C_ports) : Char; external 'async12w';πProcedure ComWriteCh(comport:C_ports; Ch:Char); external 'async12w';πProcedure ComWriteChW(comport:C_ports; Ch:Char); external 'async12w';πProcedure ClearCom(ComPort:C_Ports;IO:Char); external 'async12w';πFunction ComBufferLeft(ComPort:C_ports; IO:Char) : Word; external 'async12w';πProcedure ComWaitForClear(ComPort:C_ports); external 'async12w';πProcedure ComWrite(ComPort:C_ports; St:String); external 'async12w';πProcedure ComWriteln(ComPort:C_ports; St:String); external 'async12w';πProcedure ComWriteWithDelay(ComPort:C_ports; St:String; Dly:Word); external 'async12w';πProcedure ComReadln(ComPort:C_ports; Var St:String;Size:Byte; Echo:Boolean); external 'async12w';πProcedure SetRTSmode(ComPort:C_ports; Mode:Boolean; RTSOn,RTSOff:Word); external 'async12w';πProcedure SetCTSMode(ComPort:Byte; Mode:Boolean); external 'async12w';πProcedure SoftHandshake(ComPort:Byte; Mode:Boolean; Start,Stop:Char); external 'async12w';πFunction ComExist(ComPort:C_ports) : Boolean; external 'async12w';πFunction ComTrueBaud(Baud:Longint) : Real; external 'async12w';πProcedure ComParams(ComPort:C_ports; Baud:LongInt; WordSize:Byte;π Parity:Char; StopBits:Byte); external 'async12w';πFunction OpenCom(ComPort:C_ports; InBufferSize,OutBufferSize:Word) : Boolean; external 'async12w';πProcedure CloseCom(ComPort:C_ports); external 'async12w';πProcedure CloseAllComs; external 'async12w';πProcedure ComSetEoln(ComPort:C_ports;EolnCh : T_eoln); external 'async12w';ππFunction ComGetBufsize(ComPort:C_ports;IO : Char) : WORD; external 'async12w';πππEnd.ππ{ ------------------------------ TEST PROGRAM ----------------------- }ππProgram Asynctst;ππUsesπ Wincrt,π Asyncwin;ππ{----Demo main program for Async12w}ππVarπ p : Byte;π s : string;π i : Integer;ππBeginπ Write('Enter serial port number [1..4] : '); readln(p);π IF ComExist(p) And OpenCom(p,1024,1024)π Thenπ Beginπ ComParams(p,9600,8,'N',1);ππ {----Hayes modems echo a cr,lf so lf as eoln char is easier to program.π The cr is skipped also. Default eoln character is cr, equivalentπ to BP's readln procedure}π ComSetEoln(p,c_lf);π Writeln('Enter a Hayes Command, like ATX1');π Readln(s);π If (s<>'')π THENπ BEGINπ Write('Sending...');π ComWriteWithDelay(p,s+#13#10,500);π Writeln(' ok, press <enter> to continue.');ππ Readln;π Repeatπ Write('[',CombufferLeft(p,'I'):3,']');π ComReadln(p,s,255,false);π Writeln('[',ComBufferLeft(p,'I'):3,']',s);π Until (ComBufferLeft(p,'I')=1024);π END;π CloseCom(p);π Endπ Else Writeln('Error opening COM',p,' port');πEND.πππ 47 08-24-9413:28ALL WILLEM VAN SCHAIK Complete Comm package SWAG9408 ≈ÖY 206 ╣J { ---------------------------------------------------------------------------π unit COM.PASππ Turbo Pascal (version 4.0 or higher) unit for serial communication whichπ is based on interrupt routines and includes buffering of incoming data.ππ Features:ππ - supports COM1 and COM2 in parallelπ - baudrates up to 115200 baudπ - RTS/CTS and XON/XOFF flow controlππ Version 3.0 - May 1994ππ Copyright 1994, Willem van Schaik - Oirschot - Netherlandsππ ---------------------------------------------------------------------------π}ππ unit Com;ππ interfaceππ uses Crt, Dos;ππ typeπ PortType = (COM1, COM2);π BaudType = (B110, B150, B300, B600, B1200, B2400, B4800,π B9600, B19200, B38400, B57600, B115200);π ParityType = (None, Odd, Even, Mark, Space);π LengthType = (D5, D6, D7, D8);π StopType = (S1, S2);π FlowType = (No, RtsCts, XonXoff);ππ procedure InitCom (PortNumber : PortType;π BaudRate : BaudType;π ParityBit : ParityType;π DataLength : LengthType;π StopBits : StopType;π FlowControl : FlowType);π procedure ExitCom (PortNumber : PortType);π function ComReceived (PortNumber : PortType) : boolean;π function ReadCom (PortNumber : PortType) : char;π function ComAllowed (PortNumber : PortType) : boolean;π procedure WriteCom (PortNumber : PortType; OutByte : char);π procedure BreakCom (PortNumber : PortType);ππ implementationππ typeπ IntBlock = recordπ IntOldIP : integer;π IntOldCS : integer;π IntNumber : byte;π end;ππ INS8250 = recordπ DLL : integer; { divisor latch low register (if LCR bit7 = 1) }π DLH : integer; { divisor latch high register (if LCR bit7 = 1) }π THR : integer; { transmit holding register }π RBR : integer; { receive holding register }π IER : integer; { interrupt enable register }π LCR : integer; { line control register }π MCR : integer; { modem control register }π LSR : integer; { line status register }π MSR : integer; { modem status register }π end;ππ constπ IntDS : integer = 0;π ComPort : array [COM1..COM2] of INS8250 =π ((DLL : $3F8 ; DLH : $3F9 ; THR : $3F8 ; RBR : $3F8 ;π IER : $3F9 ; LCR : $3FB ; MCR : $3FC ; LSR : $3FD ; MSR : $3FE),π (DLL : $2F8 ; DLH : $2F9 ; THR : $2F8 ; RBR : $2F8 ;π IER : $2F9 ; LCR : $2FB ; MCR : $2FC ; LSR : $2FD ; MSR : $2FE));π { size of the input buffer and the amount of free space to disable flowπ from the other side and to enable it again }π ComBufferSize = 4096;π ComFlowLower = 256;π ComFlowUpper = 1024;ππ varπ ComBuffer : array [COM1 .. COM2, 0..(ComBufferSize-1)] of byte;π ComBufferHead, ComBufferTail : array [COM1 .. COM2] of integer;π ComFlowControl : array [COM1 .. COM2] of FlowType;π ComFlowHalted : array [COM1 .. COM2] of boolean;π ComXoffReceived : array [COM1 .. COM2] of boolean;π ComBlock : array [COM1 .. COM2] of IntBlock;ππ{ ---------------------------------------------------------------------------π InstallComIntππ To install an interrupt routine, first the old routine vector is read andπ stored using function 35 hex. Next the new routine is installed usingπ function 25 hex.π ---------------------------------------------------------------------------π}ππ procedure InstallComInt (IntNumber : byte; IntHandler : integer;π var Block : IntBlock);π varπ Regs : Registers;ππ beginπ IntDS := DSeg;π Block.IntNumber := IntNumber;π Regs.AH := $35;π Regs.AL := IntNumber;π MSDos (Dos.Registers(Regs));π Block.IntOldCS := Regs.ES;π Block.IntOldIP := Regs.BX;π Regs.AH := $25;π Regs.AL := IntNumber;π Regs.DS := CSeg;π Regs.DX := IntHandler;π MSDos (Dos.Registers(Regs));π end;ππ{ ---------------------------------------------------------------------------π UnInstallComIntππ Uninstalling the interrupt routine is done by resetting the old interruptπ vector using function 25.π ---------------------------------------------------------------------------π}ππ procedure UnInstallComInt (var Block : IntBlock);ππ varπ Regs : Registers;ππ beginπ Regs.AH := $25;π Regs.AL := Block.IntNumber;π Regs.DS := Block.IntOldCS;π Regs.DX := Block.IntOldIP;π MSDos (Dos.Registers(Regs));π end;ππ{ ---------------------------------------------------------------------------π Com1IntHandlerππ This routine is installed as the interrupt routine by InstallComInt, whichπ in its turn is called by InitCom at initialisation of the unit.ππ When a byte arrives at the COM-port, first action is to get the byte fromπ the UART register and store it the buffer. Next the buffer pointer isπ increased. Depending on flow control being enabled or not, it is checked ifπ the free space has become less then ComFlowLower and if that is the case theπ other party (the DCE) is signalled to stop transmitting data.ππ When the type of flow control specified at calling InitCom is RtsCts (thisπ is hardware flow control), the RTS bit of the MCR register is lowered. Ifπ flow control is XonXoff (software flow control), an XOFF character (13 hex)π is send to the other party by calling WriteCom.ππ Finally the routine must be ended with a CLI instruction and the interruptπ flags must be cleared.π ---------------------------------------------------------------------------π}ππ procedure Com1IntHandler (Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BPπ: word);π interrupt;ππ beginπ ComBuffer[COM1, ComBufferHead[COM1]] := Port[ComPort[COM1].RBR];π if ComFlowControl[COM1] = No thenπ beginπ ComBufferHead[COM1] := (ComBufferHead[COM1] + 1) mod ComBufferSize;π endπ else { when flow control increase buffer pointer later }π beginπ { check for incoming XON/XOFF }π if ComFlowControl[COM1] = XonXoff thenπ beginπ if ComBuffer[COM1, ComBufferHead[COM1]] = $11 then { XON }π ComXoffReceived[COM1] := falseπ else if ComBuffer[COM1, ComBufferHead[COM1]] = $13 then { XOFF }π ComXoffReceived[COM1] := true;π end;π ComBufferHead[COM1] := (ComBufferHead[COM1] + 1) mod ComBufferSize;π { check if outgoing must be temporized }π if not ComFlowHalted[COM1] thenπ if (ComBufferHead[COM1] >= ComBufferTail[COM1]) andπ (ComBufferTail[COM1] - ComBufferHead[COM1] + ComBufferSize < ComFlowLower)π orπ (ComBufferHead[COM1] < ComBufferTail[COM1]) andπ (ComBufferTail[COM1] - ComBufferHead[COM1] < ComFlowLower) thenπ begin { buffer gets too full }π if ComFlowControl[COM1] = RtsCts thenπ Port[ComPort[COM1].MCR] := Port[ComPort[COM1].MCR] and $FD { lower RTS }π else if ComFlowControl[COM1] = XonXoff thenπ WriteCom (COM1, #$13); { send XOFF }π ComFlowHalted[COM1] := true;π end;π end;π inline ($FA); { CLI }π Port[$20] := $20; { clear interrupt flag }π end;ππ{ ---------------------------------------------------------------------------π Com2IntHandlerππ This routine is identical to Com1IntHandler, only for COM2.π ---------------------------------------------------------------------------π}ππ procedure Com2IntHandler (Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP : word);π interrupt;ππ beginπ ComBuffer[COM2, ComBufferHead[COM2]] := Port[ComPort[COM2].RBR];π if ComFlowControl[COM2] = No thenπ beginπ ComBufferHead[COM2] := (ComBufferHead[COM2] + 1) mod ComBufferSize;π endπ else { when flow control increase buffer pointer later }π beginπ { check for incoming XON/XOFF }π if ComFlowControl[COM2] = XonXoff thenπ beginπ if ComBuffer[COM2, ComBufferHead[COM2]] = $11 then { XON }π ComXoffReceived[COM2] := falseπ else if ComBuffer[COM2, ComBufferHead[COM2]] = $13 then { XOFF }π ComXoffReceived[COM2] := true;π end;π ComBufferHead[COM2] := (ComBufferHead[COM2] + 1) mod ComBufferSize;π { check if outgoing must be temporized }π if not ComFlowHalted[COM2] thenπ if (ComBufferHead[COM2] >= ComBufferTail[COM2]) andπ (ComBufferTail[COM2] - ComBufferHead[COM2] + ComBufferSize < ComFlowLower)π orπ (ComBufferHead[COM2] < ComBufferTail[COM2]) andπ (ComBufferTail[COM2] - ComBufferHead[COM2] < ComFlowLower) thenπ begin { buffer gets too full }π if ComFlowControl[COM2] = RtsCts thenπ Port[ComPort[COM2].MCR] := Port[ComPort[COM2].MCR] and $FD { lower RTS }π else if ComFlowControl[COM2] = XonXoff thenπ WriteCom (COM2, #$13); { send XOFF }π ComFlowHalted[COM2] := true;π end;π end;π inline ($FA); { CLI }π Port[$20] := $20; { clear interrupt flag }π end;ππ{ ---------------------------------------------------------------------------π InitCom;ππ For each of the COM ports that will be used, this routine must be calledπ to initialize the UART and to install the interrrupt routine. The firstπ five parameters define the serial protocol (baudrate B150..B11500, parityπ None..Space, length D5..D8 and number of stop bits S1 or S2). The lastπ parameter specifies the type of flow control, with allowed values No,π RtsCts and XonXoff.ππ The control signals DTR and RTS of the COM port (plus the OUT2 signal, whichπ is used by some internal modems) are raised to signal the other end of theπ line that the port is ready to receive data.π ---------------------------------------------------------------------------π}ππ procedure InitCom; { (PortNumber : PortType;π BaudRate : BaudType;π ParityBit : ParityType;π DataLength : LengthType;π StopBits : StopType;π FlowControl : FlowType); }π constπ BaudReg : array [B110 .. B115200] of word =π ($0417, $0300, $0180, $00C0, $0060, $0030,π $0018, $000C, $0006, $0003, $0002, $0001);π ParityReg : array [None..Space] of byte =π ($00, $08, $18, $28, $38);π LengthReg : array [D5 .. D8] of byte =π ($00, $01, $02, $03);π StopReg : array [S1 .. S2] of byte =π ($00, $04);ππ varπ Regs : Registers;ππ beginπ { enable the interrupt (IRQ4 resp. IRQ3) for the specified COM port, byπ resetting the bits in the Interrupt Mask Register of the 8259 interruptπ controller }π if PortNumber = COM1 thenπ beginπ InstallComInt($0C, Ofs(Com1IntHandler), ComBlock[COM1]);π Port[$21] := Port[$21] and $EFπ endπ else if PortNumber = COM2 thenπ beginπ InstallComInt($0B, Ofs(Com2IntHandler), ComBlock[COM2]);π Port[$21] := Port[$21] and $F7π end;ππ Port[ComPort[PortNumber].LCR] := $80; { switch to write latch reg }π Port[ComPort[PortNumber].DLH] := Hi (BaudReg [BaudRate]);π Port[ComPort[PortNumber].DLL] := Lo (BaudReg [BaudRate]);π Port[ComPort[PortNumber].LCR] := $00 orπ ParityReg [ParityBit] orπ LengthReg [DataLength] orπ StopReg [StopBits];π Port[ComPort[PortNumber].IER] := $01; { enable interrupts }π Port[ComPort[PortNumber].MCR] := $01 or { raise DTR }π $02 or { raise RTS }π $08; { raise OUT2 }π ComBufferHead[PortNumber] := 0;π ComBufferTail[PortNumber] := 0;π ComFlowControl[PortNumber] := FlowControl;π ComFlowHalted[PortNumber] := false;π ComXoffReceived[PortNumber] := false;π end;ππ{ ---------------------------------------------------------------------------π ExitCom;ππ This routine must be called for each COM port in use, to remove theπ interrupt routine and to reset the control lines.π ---------------------------------------------------------------------------π}ππ procedure ExitCom; { (PortNumber : PortType) }ππ varπ Regs : Registers;ππ beginπ { disable the interrupt (IRQ4 resp. IRQ3) for the specified COM port, byπ setting the bits in the Interrupt Mask Register of the 8259 interruptπ controller }π if PortNumber = COM1 thenπ Port[$21] := Port[$21] or $10π else if PortNumber = COM2 thenπ Port[$21] := Port[$21] or $08;ππ Port[ComPort[PortNumber].LCR] := Port[ComPort[PortNumber].LCR] and $7F;π Port[ComPort[PortNumber].IER] := 0; { disable interrupts }π Port[ComPort[PortNumber].MCR] := 0; { lower DTR, RTS and OUT2 }π UnInstallComInt(ComBlock[PortNumber]);π end;ππ{ ---------------------------------------------------------------------------π ComReceived;ππ When the head and tail pointer (for writing resp. reading bytes) are notπ pointing to the same byte in the buffer, a byte has arrived from the UARTπ and was stored in the buffer by the interrupt routine.π ---------------------------------------------------------------------------π}ππ function ComReceived; { (PortNumber : PortType) : boolean; }ππ beginπ ComReceived := ComBufferHead[PortNumber] <> ComBufferTail[PortNumber];π end;ππ{ ---------------------------------------------------------------------------π ReadCom;ππ Calling this function will wait for a byte in the buffer (if there is notπ yet one present) and then return it. The tail buffer pointer is increasedπ and if flow from the other side was stopped, a check is made if the freeπ space has again become more then ComFlowUpper. In that situation, dependingπ on the type of flow control, either the RTS line is raised or and XON byteπ (11 hex) is send to the other party.π ---------------------------------------------------------------------------π}ππ function ReadCom; { (PortNumber : PortType) : char; }ππ beginπ while ComBufferHead[PortNumber] = ComBufferTail[PortNumber] do Delay(10);π ReadCom := char(ComBuffer[PortNumber, ComBufferTail[PortNumber]]);π ComBufferTail[PortNumber] := (ComBufferTail[PortNumber] + 1) mod ComBufferSize;π if (ComFlowControl[PortNumber] <> No) and ComFlowHalted[PortNumber] thenπ if (ComBufferHead[PortNumber] >= ComBufferTail[PortNumber]) andπ (ComBufferTail[PortNumber] - ComBufferHead[PortNumber] + ComBufferSize > ComFlowUpper) orπ (ComBufferHead[PortNumber] < ComBufferTail[PortNumber]) andπ (ComBufferTail[PortNumber] - ComBufferHead[PortNumber] > ComFlowUpper)πthenπ begin { buffer has emptied enough }π if ComFlowControl[PortNumber] = RtsCts thenπ Port[ComPort[PortNumber].MCR] := Port[ComPort[PortNumber].MCR] or $02 {πraise RTS }π else if ComFlowControl[PortNumber] = XonXoff thenπ WriteCom (PortNumber, #$11); { send XON }π ComFlowHalted[PortNumber] := false;π end;π end;ππ{ ---------------------------------------------------------------------------π ComAllowed;ππ With this function it is possible to check if writing data to the COM portπ is allowed. When there is no flow control no check is made on any controlπ line and the result will always be true. When hardware type flow control isπ enabled, DSR (and CD) and CTS must be high. In case of software flowπ control DSR must be high and a check is made if an XOFF byte was received.π ---------------------------------------------------------------------------π}ππ function ComAllowed; { (PortNumber : PortType) : boolean; }ππ beginπ ComAllowed := true;π if (ComFlowControl[PortNumber] = RtsCts) thenπ beginπ { replace in next line both $30 with $B0 for checking on CD, DSR and CTS}π if ((Port[ComPort[PortNumber].MSR] and $30) <> $30) then { no DSR or CTS}π ComAllowed := false;π endπ else if (ComFlowControl[PortNumber] = XonXoff) thenπ beginπ { replace in next line both $20 with $A0 for checking on CD and DSR }π if ((Port[ComPort[PortNumber].MSR] and $20) <> $20) or { no DSR }π (ComXoffReceived[PortNumber]) then { XOFF received }π ComAllowed := false;π endπ end;ππ{ ---------------------------------------------------------------------------π WriteCom;ππ This routine is to write a byte to the COM port. However, when necessaryπ this will be delayed until the previous output byte is out the the UART.π ---------------------------------------------------------------------------π}ππ procedure WriteCom; { (PortNumber : PortType; OutByte : char); }ππ beginπ while ((Port[ComPort[PortNumber].LSR] and $20) <> $20) do { TD empty }π Delay(1);π Port[ComPort[PortNumber].THR] := byte(OutByte);π end;ππ{ ---------------------------------------------------------------------------π BreakCom;ππ With this routine the TD line can be lowered for 200 msec, which is a so-π called break signal.π ---------------------------------------------------------------------------π}ππ procedure BreakCom; { (PortNumber : PortType); }ππ beginπ Port[ComPort[PortNumber].LCR] := Port[ComPort[PortNumber].LCR] or $40;π Delay (200); { 0.2 seconds }π Port[ComPort[PortNumber].LCR] := Port[ComPort[PortNumber].LCR] and $BF;π end;ππ end.ππ{ ---------------------------------------------------------------------------π end of COM.PASπ ---------------------------------------------------------------------------π}ππ{ ---------------------------------------------------------------------------π program TTY.PASππ Sample terminal emulation using simple teletype protocol to be used withπ the unit COM.PAS for serial communnication.ππ Features:ππ - switching between COM1 and COM2π - baudrates up to 115200 baudπ - RTS/CTS and XON/XOFF flow controlπ - debug mode to display control charactersππ Version 3.0 - May 1994ππ Copyright 1994, Willem van Schaik - Oirschot - Netherlandsππ ---------------------------------------------------------------------------π}ππ program Tty;ππ uses Crt, Com;ππ constπ Ascii : array [0..255] of string [5] =π ('<NUL>','<SOH>','<STX>','<ETX>','<EOT>','<ENQ>','<ACK>','<BEL>',π '<BS>','<HT>','<LF>','<VT>','<FF>','<CR>','<SO>','<SI>',π '<DLE>','<DC1>','<DC2>','<DC3>','<DC4>','<NAK>','<SYN>','<ETB>',π '<CAN>','<EM>','<SUB>','<ESC>','<FS>','<GS>','<RS>','<US>',π ' ','!','"','#','$','%','&','''','(',')','*','+',',','-','.','/',π '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?',π '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',π 'P','Q','R','S','T','U','V','W','X','Y','Z','[','\',']','^','_',π '`','a','b','c','d','e','f','g','h','i','j','k','l','m','n','o',π 'p','q','r','s','t','u','v','w','x','y','z','{','|','}','~','<DEL>',π '<128>','<129>','<130>','<131>','<132>','<133>','<134>','<135>',π '<136>','<137>','<138>','<139>','<140>','<141>','<142>','<143>',π '<144>','<145>','<146>','<147>','<148>','<149>','<150>','<151>',π '<152>','<153>','<154>','<155>','<156>','<157>','<158>','<159>',π '<160>','<161>','<162>','<163>','<164>','<165>','<166>','<167>',π '<168>','<169>','<170>','<171>','<172>','<173>','<174>','<175>',π '<176>','<177>','<178>','<179>','<180>','<181>','<182>','<183>',π '<184>','<185>','<186>','<187>','<188>','<189>','<190>','<191>',π '<192>','<193>','<194>','<195>','<196>','<197>','<198>','<199>',π '<200>','<201>','<202>','<203>','<204>','<205>','<206>','<207>',π '<208>','<209>','<210>','<211>','<212>','<213>','<214>','<215>',π '<216>','<217>','<218>','<219>','<220>','<221>','<222>','<223>',π '<224>','<225>','<226>','<227>','<228>','<229>','<230>','<231>',π '<232>','<233>','<234>','<235>','<236>','<237>','<238>','<239>',π '<240>','<241>','<242>','<243>','<244>','<245>','<246>','<247>',π '<248>','<249>','<250>','<251>','<252>','<253>','<254>','<255>');ππ varπ TtyPort : PortType;π TtyBaud : BaudType;π TtyParity : ParityType;π TtyLength : LengthType;π TtyStop : StopType;π TtyFlow : FlowType;ππ ChCom, ChKey : char;π DoDebug : boolean;π GoExit : boolean;ππ{ ---------------------------------------------------------------------------π TtyGetParsππ Procedure to handle alt-key combinations that are used to change theπ settings of the terminal emulation protocol.π ---------------------------------------------------------------------------π}ππ procedure TtyGetPars (AltKey : char);ππ varπ ParsInput : string[16];ππ beginπ case AltKey ofππ #120: { alt-1 }π beginπ if WhereX > 1 then Writeln;π Writeln ('TTY: port = COM1:');π if TtyPort <> COM1 thenπ beginπ ExitCom (TtyPort);π TtyPort := COM1;π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow)π end;π end;ππ #121: { alt-2 }π beginπ if WhereX > 1 then Writeln;π Writeln ('TTY: port = COM2:');π if TtyPort <> COM2 thenπ beginπ ExitCom (TtyPort);π TtyPort := COM2;π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow)π end;π end;ππ #48: { alt-B }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: baudrate = ');π Readln (ParsInput);π if (ParsInput = '3') or (ParsInput = '300') then TtyBaud := B300π else if (ParsInput = '6') or (ParsInput = '600') then TtyBaud := B600π else if (ParsInput = '12') or (ParsInput = '1200') then TtyBaud := B1200π else if (ParsInput = '24') or (ParsInput = '2400') then TtyBaud := B2400π else if (ParsInput = '48') or (ParsInput = '4800') then TtyBaud := B4800π else if (ParsInput = '96') or (ParsInput = '9600') then TtyBaud := B9600π else if (ParsInput = '192') or (ParsInput = '19200') then TtyBaud := B19200π else if (ParsInput = '384') or (ParsInput = '38400') then TtyBaud := B38400π elseπ Writeln (' baudrate = 300,600,1200,2400,4800,9600,19200,38400');π ExitCom (TtyPort);π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow);π end;ππ #38: { alt-L }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: word length = ');π Readln (ParsInput);π case ParsInput[1] ofπ '5': TtyLength := D5;π '6': TtyLength := D6;π '7': TtyLength := D7;π '8': TtyLength := D8;π elseπ Writeln (' word length = 5,6,7,8');π end;π ExitCom (TtyPort);π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow);π end;ππ #25: { alt-P }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: parity bit = ');π Readln (ParsInput);π case ParsInput[1] ofπ 'n', 'N': TtyParity := None;π 'o', 'O': TtyParity := Odd;π 'e', 'E': TtyParity := Even;π 'm', 'O': TtyParity := Mark;π 's', 'O': TtyParity := Space;π elseπ Writeln (' parity bit = none,odd,even,mark,space');π end;π ExitCom (TtyPort);π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow);π end;ππ #31: { alt-S }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: stop bits = ');π Readln (ParsInput);π case ParsInput[1] ofπ '1': TtyStop := S1;π '2': TtyStop := S2;π elseπ Writeln (' stop bits = 1,2');π end;π ExitCom (TtyPort);π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow);π end;ππ #33: { alt-F }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: flow control = ');π Readln (ParsInput);π case ParsInput[1] ofπ 'n', 'N': TtyFlow := No;π 'r', 'R': TtyFlow := RtsCts;π 'x', 'X': TtyFlow := XonXoff;π elseπ Writeln (' flow control = no,rts/cts,xon/xoff');π end;π ExitCom (TtyPort);π InitCom (TtyPort, TtyBaud, TtyParity, TtyLength, TtyStop, TtyFlow);π end;ππ #23: { alt-I }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: port = COM', ord(TtyPort)+1, ': ');π case TtyBaud ofπ B110: Write ('baudrate = 110 ');π B150: Write ('baudrate = 150 ');π B300: Write ('baudrate = 300 ');π B600: Write ('baudrate = 600 ');π B1200: Write ('baudrate = 1200 ');π B2400: Write ('baudrate = 2400 ');π B4800: Write ('baudrate = 4800 ');π B9600: Write ('baudrate = 9600 ');π B19200: Write ('baudrate = 19200 ');π B38400: Write ('baudrate = 38400 ');π B57600: Write ('baudrate = 57600 ');π B115200: Write ('baudrate = 115200 ');π end;π case TtyParity ofπ None: Writeln ('parity bit = none');π Odd: Writeln ('parity bit = odd');π Even: Writeln ('parity bit = even');π Mark: Writeln ('parity bit = mark');π Space: Writeln ('parity bit = space');π end;π case TtyFlow ofπ No: Write (' flow = no ');π RtsCts: Write (' flow = rts/cts ');π XonXoff: Write (' flow = xon/xoff ');π end;π Write ('word length = ', ord(TtyLength)+5, ' ');π Writeln ('stop bits = ', ord(TtyStop)+1);π end;ππ #35: { alt-H }π beginπ if WhereX > 1 then Writeln;π Write ('TTY: alt-1 - COM1 ');π Write ('alt-B - baudrate ');π Write ('alt-I - info');π Writeln;π Write (' alt-2 - COM2 ');π Write ('alt-L - word length ');π Write ('alt-H - help');π Writeln;π Write (' alt-F - flow ');π Write ('alt-P - parity bit');π Writeln;π Write (' alt-D - debug ');π Write ('alt-S - stop bits ');π Write ('alt-X - exit');π Writeln;π end;ππ #32: { alt-D }π beginπ DoDebug := not DoDebug;π if WhereX > 1 then Writeln;π if DoDebug thenπ Writeln ('TTY: debug = on')π elseπ Writeln ('TTY: debug = off');π end;ππ #45: { alt-X }π beginπ if WhereX > 1 then Writeln;π Writeln ('TTY: exit');π GoExit := true;π end;ππ end; { case ChKey }π end; { procedure TtyGetPars }ππ{ ---------------------------------------------------------------------------π 48 08-24-9413:37ALL MIKE WHITAKER Full Fossil Code SWAG9408 ╓┐Ç│ 99 ╣J π(* ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄π █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█π █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█π █░░░░░░░█████████████████████████████████████████████░░░░░░░░░░░░░█π █░░░░░░░██ ██ ░░░░░░░░░░░░█π █░░░░░░░██ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░██ ░░░░░░░░░░░░█π █░░░░░░░██ ░░░░░░░██████░░░░███████░░░███████░░██░░██ ░░░░░░░░░░░░█π █░░░░░░░███████░░█ █░░░█ ░░█ ░██ ░██ ░░░░░░░░░░░░█π █░░░░░░░██ ░█ ░░░░░█ ░░███████ ░░███████ ░██ ░██ ░░░░░░░░░░░░█π █░░░░░░░██ ░░░░░░█ ░░░░░█ ░░░ █ ░░░ █ ░██ ░██ ░░░░░░░░░░░░█π █░░░░░░░██ ░░░░░░░██████ ░░███████ ░░███████ ░██ ░████████░░░░░░░█π █░░░░░░░░ ░░░░░░░░ ░░░░ ░░░ ░░ ░ ░░░░░░█π █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█π █░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░█π ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀π ■ FIDO/OPUS/SEADOG/Standard Interface Layer ■ Version 1.02ππ Interface for X00 and BNU Fossil Driver(s)ππ Written by: Mike Whitaker *)ππ{$R-,S-,I-,D-,F+,V-,B-,N-}ππUnit Fossil;ππInterfaceππUses Dos, Crt;ππConst CTS_RTS = 2; { To Control Flow Control }π XON_XOFF = 9;ππType Fossil_Struct = Recordπ StructSize : Word;π MajorVer : Byte;π MinVer : Byte;π FOS_ID : Array [1..2] of Word;π Inp_Buffer : Word;π Recv_Bytes : Word;π Out_Buffer : Word;π Send_Bytes : Word;π SWidth : Byte;π SHeight : Byte;π BaudRate : Byteπ End;ππVar FosPort : Byte;πππFunction Install_Fossil (ComPort:Byte):Boolean;πProcedure Close_Fossil (ComPort:Byte);πProcedure Set_Fossil (ComPort:Byte; BaudRate:LongInt; DataBits:Byte;π Parity:Char; StopBits:Byte);πProcedure SendChar (K:Char);πProcedure SendString (S:String);πFunction GetChar:Char;πFunction Fossil_Chars:Boolean;πFunction Fossil_Carrier:Boolean;πProcedure Fossil_DTR (ComPort:Byte; State:Boolean);πProcedure Hangup;πProcedure Fossil_Timer (Var Tick_Int, Ints_Sec:Byte; MS_Tics:Integer);πProcedure Fossil_OutPut_FLUSH (ComPort:Byte);πProcedure Fossil_Nuke_Input (ComPort:Byte);πProcedure Fossil_Nuke_OutPut (ComPort:Byte);πFunction NoWait_Send (K:Char):Boolean;πFunction Fossil_Peek:Char;π{Function Fossil_GetChar:Char;}πFunction Fossil_Wait:Char;πProcedure Fossil_FLOW (State:Byte);πProcedure Set_CtrlC (ComPort, State:Byte);πFunction CtrlC_Check (ComPort:Byte):Boolean;πProcedure Fossil_GotoXY (X,Y:Byte);πProcedure Fossil_Position (Var X,Y:Byte);πFunction Fossil_WhereX:Byte;πFunction Fossil_WhereY:Byte;πProcedure ANSI_Write (K:Char);πProcedure WatchDog (Status:Boolean);πProcedure BIOS_Write (K:Char);πFunction Add_Fossil_Proc (Var P):Boolean;πFunction Delete_Fossil_Proc (Var P):Boolean;πProcedure WarmBoot;πProcedure ColdBoot;πFunction Fossil_BlockRead (Bytes:Word; Var Buffer):Integer;πFunction Fossil_BlockWrite (Bytes:Word; Var Buffer):Integer;πFunction Fossil_Descrip (ComPort:Byte):String;πFunction Fos_Ringing: Boolean;πImplementationππππVar R:Registers;ππProcedure Delay (I:Integer);πBeginπ R.Ah := $86;π Move (I,R.Cx,2);π Intr ($15,R)πEnd;ππFunction Install_Fossil (ComPort:Byte):Boolean;πBegin { Initializes the Specified }π R.Ah := $04; { Communications Port }π R.Dx := ComPort - 1; { Sets FOSPORT to COMPORT }π R.Bx := $4F50;π Intr ($14,R);π Install_Fossil := R.Ax = $1954;π FosPort := ComPort - 1πEnd;ππProcedure Close_Fossil (ComPort:Byte); { Closes the Initialized }πBegin { Communications Port }π R.Ah := $05;π R.Dx := ComPort - 1;π Intr ($14,R);π FosPort := 255πEnd;πππProcedure Set_Fossil (ComPort:Byte; BaudRate:LongInt; DataBits:Byte;π Parity:Char; StopBits:Byte);πVar Baud,Code:Byte; { Sets the to the COMPORT }πBegin { The BaudRate, DataBits, }π Case BaudRate of { The Parity, And StopBits }π 1200 : Baud := 128; { Sets FOSPORT to COMPORT }π 2400 : Baud := 160;π 4800 : Baud := 192;π 9600 : Baud := 224;π 19200 : Baud := 0π Else If BaudRate = 38400 Then Baud := 32π End;π Case DataBits ofπ { 5 : Baud := Baud + 0; }π 6 : Baud := Baud + 1;π 7 : Baud := Baud + 2;π 8 : Baud := Baud + 3π End;π Case Parity ofπ { 'N' : Baud := Baud + 0; }π 'O' : Baud := Baud + 8;π 'E' : Baud := Baud + 24π End;π Case StopBits ofπ 1 : Baud := Baud + 0;π 2 : Baud := Baud + 4π End;π R.Ah := 0;π R.Al := Baud;π R.Dx := ComPort - 1;π Intr ($14,R);π FosPort := ComPort - 1πEnd;ππFunction Fos_Ringing: Boolean;πvarπ CC : Char;πbeginπ Fos_Ringing := False;π R.Ah := $0C;π R.Dx := fosport;π Intr($14, R);π if r.ax = $FFFF thenπ Fos_ringing := falseπ elseπ beginπ cc := chr(r.al);π if cc = #13 thenπ Fos_ringing := true;π end;πend;ππππProcedure SendChar (K:Char); { Transmitts a Character }πBegin { through FOSPORT Comm Port }π R.Ah := $01; { and then Waits. }π R.Al := Ord(K);π R.Dx := FosPort;π Intr ($14,R)πEnd;πππProcedure SendString (S:String); { Sends a String through the }πVar I:Integer;πBeginπ I:=Fossil_BlockWrite (Length(S),S)πEnd;πππFunction GetChar:Char; { Gets a Character from the }πBegin { FOSPORT Communications Port}π R.Ah := $02;π R.Dx := FosPort;π Intr ($14,R);π GetChar := Chr(R.Al)πEnd;ππFunction Fossil_Chars:Boolean;πBeginπ R.Ah := $03;π R.Dx := FosPort;π Intr ($14,R);π Fossil_Chars := (R.Ah And 1) = 1πEnd;ππFunction Fossil_Carrier:Boolean; { Detects whether a Carrier }πBegin { is on FOSPORT Port }π R.Ah := $03;π R.Dx := FosPort;π Intr ($14,R);π Fossil_Carrier := (R.Al And 128) = 128πEnd;ππProcedure Fossil_DTR (ComPort:Byte; State:Boolean);πBegin { Lowers/Raises the DTR on }π R.Ah := $06; { COMPORT }π R.Al := Byte(State);π R.Dx := ComPort - 1;π Intr ($14,R)πEnd;πππProcedure Hangup;πBeginπ If Not Fossil_Carrier Then Exit;π Fossil_DTR (FosPort + 1,False);π Delay (700);π Fossil_DTR (FosPort + 1,True);π If Fossil_Carrier Then SendString ('+++')πEnd;ππProcedure Fossil_Timer (Var Tick_Int, Ints_Sec:Byte; MS_Tics:Integer);πBeginπ R.Ah := $07;π Intr ($14,R);π Tick_Int := R.Al;π Ints_Sec := R.Ah;π MS_Tics := R.DxπEnd;πππProcedure Fossil_OutPut_FLUSH (ComPort:Byte);πBegin { Forecs the OutPut Chars }π R.Ah := $08; { out of the Buffer }π R.Dx := ComPort - 1;π Intr ($14,R)πEnd;ππProcedure Fossil_Nuke_OutPut (ComPort:Byte);πBegin { Purges the OutPut Buffer }π R.Ah := $09;π R.Dx := ComPort - 1;π Intr ($14,R)πEnd;ππProcedure Fossil_Nuke_Input (ComPort:Byte);πBegin { Purges the Input Buffer }π R.Ah := $0A;π R.Dx := ComPort - 1;π Intr ($14,R)πEnd;ππFunction NoWait_Send (K:Char):Boolean;πBeginπ R.Ah := $0B;π R.Al := Ord(K);π R.Dx := FosPort;π Intr ($14,R);π NoWait_Send := Boolean(R.Ax)πEnd;ππFunction Fossil_Peek:Char; { Checks out what the Next }πBegin { Character is in FOSPORT }π R.Ah := $0C; { Without Taking it out of }π R.Dx := FosPort; { the Bufffer }π Intr ($14,R);π Fossil_Peek := Chr(R.Al)πEnd;ππFunction Fossil_GetChar:Char; { Gets Character from Input Buffer }πBegin { $FFFF if none: HIGH Byte is Scan }π R.Ah := $0D; { code }π R.Dx := FosPort;π Intr ($14,R);π Fossil_GetChar := Chr(R.Al)πEnd;ππFunction Fossil_Wait:Char; { Waits until a Character has been }πBegin { Receieved }π R.Ah := $0E;π R.Dx := FosPort;π Intr ($14,R);π Fossil_Wait := Chr(R.Al)πEnd;ππProcedure Fossil_FLOW (State:Byte); { Sets Flow Control }πBegin { 0 = Disabled }π R.Ah := $0F; { Bit 0 & 3 = XON/XOFF } { Chars }π R.Al := State; { Bit 1 = CTS/RTS } { Signals * }π R.Dx := FosPort; { Call using the defined Constants }π Intr ($14,R)πEnd;πππProcedure Set_CtrlC (ComPort,State:Byte);πBeginπ R.Ah := $10;π R.Al := State;π R.Dx := ComPort - 1;π Intr ($14,R)πEnd;ππFunction CtrlC_Check (ComPort:Byte):Boolean;πBeginπ R.Ah := $10;π R.Al := 2;π R.Dx := ComPort - 1;π Intr ($14,R);π CtrlC_Check := Boolean(R.Ax)πEnd;ππProcedure Fossil_GotoXY (X,Y:Byte);πBeginπ R.Ah := $11;π R.Dh := Y - 1;π R.Dl := X - 1;π Intr ($14,R)πEnd;ππProcedure Fossil_Position (Var X,Y:Byte);πBeginπ R.Ah := $12;π Intr ($14,R);π X := R.Dl + 1;π Y := R.Dh + 1πEnd;ππFunction Fossil_WhereX:Byte;πBeginπ R.Ah := $12;π Intr ($14,R);π Fossil_WhereX := R.Dl + 1πEnd;ππFunction Fossil_WhereY:Byte;πBeginπ R.Ah := $12;π Intr ($14,R);π Fossil_WhereY := R.Dh + 1πEnd;ππProcedure ANSI_Write (K:Char); { Projects Character to Screen }πBegin { through ANSI.SYS }π R.Ah := $13;π R.Al := Ord(K);π R.Dx := FosPort;π Intr ($14,R)πEnd;ππProcedure WatchDog (Status:Boolean); { Sets WatchDOG = ON/OFF }πBegin { If ON then Reboots on Carrier }π R.Ah := $14; { Loss! }π R.Al := Byte(Status);π R.Dx := FosPort;π Intr ($14,R)πEnd;ππProcedure BIOS_Write (K:Char); { Writes a Character to the }πBegin { Screen Using BIOS Screen Write}π R.Ah := $15;π R.Al := Ord(K);π R.Dx := FosPort;π Intr ($14,R)πEnd;ππFunction Add_Fossil_Proc (Var P):Boolean;πBeginπ R.Ah := $16;π R.Al := $01;π R.ES := Seg (P);π R.DX := Ofs (P);π Intr ($14,R);π Add_Fossil_Proc := R.Ax = 0πEnd;ππFunction Delete_Fossil_Proc (Var P):Boolean;πBeginπ R.Ah := $16;π R.Al := $00;π R.ES := Seg (P);π R.DX := Ofs (P);π Intr ($14,R);π Delete_Fossil_Proc := R.Ax = 0πEnd;ππProcedure ColdBoot; { Does a Cold Reboot }πBeginπ R.Ah := $17;π R.Al := $00;π Intr ($14,R)πEnd;ππProcedure WarmBoot; { Does a Warm Reboot }πBeginπ R.Ah := $17;π R.Al := $01;π Intr ($14,R)πEnd;ππFunction Fossil_BlockRead (Bytes:Word; Var Buffer):Integer;πBegin { BUFFER is an Array, and BYTES is }π R.Ah := $18; { the size of the Array. }π R.Dx := FosPort; { It Returns the number of recieved }π R.Cx := Bytes; { Characters. }π R.ES := Seg (Buffer);π R.DI := Ofs (Buffer);π Intr ($14,R);π Fossil_BlockRead := R.AxπEnd;ππFunction Fossil_BlockWrite (Bytes:Word; Var Buffer):Integer;πBegin { Writes an Array of BYTES Chars }π R.Ah := $19; { to the FOSPORT from BUFFER }π R.Dx := FosPort; { Returns the number of characters }π R.Cx := Bytes; { sent. }π R.ES := Seg (Buffer);π R.DI := Ofs (Buffer);π Intr ($14,R);π Fossil_BlockWrite := R.AxπEnd;πππFunction Fossil_Descrip (ComPort:Byte):String;πVar Cnt:Integer; { Returns the Communications FOSSIL }π Fos_Arry:Fossil_Struct; { Driver Utilizing the COMPORT }π First,Second:Word; { Communications Port }π Kar:Char; { Returns the FOSSIL Driver }π S:String; { Description. }πBeginπ R.Ah := $1B;π R.Dx := ComPort - 1;π R.ES := Seg (Fos_Arry);π R.DI := Ofs (Fos_Arry);π R.CX := SizeOf (Fos_Arry);π Intr ($14,R);π First := Fos_Arry.FOS_ID[2];π Second := Fos_Arry.FOS_ID[1];π S := '';π Kar := #26;π While Kar <> #0 Do Beginπ Kar:=Chr (Mem[First:Second]);π S := S + Kar;π Second:=Second + 1π End;π Fossil_Descrip:=SπEnd;ππBeginπEnd.π 49 08-24-9413:40ALL JORDAN RITTER Great Fossil Code SWAG9408 ≈N2╤ 101 ╣J πUnit Fossil;ππInterfaceππUses Dos;ππTypeπ DriverInfo = Recordπ StrucSize : Word;π MajorVersion : Byte;π CurrentRevision : Byte;π IDPtr : Array[1..2] of Word;π InputBufferSize : Word;π InputBufferFree : Word;π OutputBufferSize: Word;π OutputBufferFree: Word;π ScreenWidth : Byte;π ScreenHieght : Byte;π BaudRate : Byte;π DriverName : String[80];π End;π MaxStr = String[255];π Str80 = String[80];ππVarπ Regs : Registers;π FossilInfo : DriverInfo;ππFunction Port_Status(Port:Byte):Word;πProcedure Set_Baud( Port:Byte; Speed:Byte);πFunction Xmit(Port:Byte; OutChar:Char):Word;πFunction CommWrite(Port:Byte; OutString:MaxStr):Word;πFunction CommRead(Port:Byte):Char;πFunction Init_Fossil(Port:Byte; BreakAddr:Word; Var MaxFunctionNum:Byte;π Var RevDoc:Byte):Word;πProcedure DeInit_Fossil(Port:Byte);πProcedure ModemDTR(Port:Byte; DTRUp:Boolean);πProcedure Get_Timer_Data(Var InterruptNum:Byte; (* Return Timing Info *)π Var TicksPerSec:Byte;π Var MillisecsPer:Word);πProcedure Flush_Output_Buffer(Port:Byte);πProcedure Purge_Output_Buffer(Port:Byte);πProcedure Purge_Input_Buffer(Port:Byte);πFunction Xmit_Nowait(Port:Byte; OutChar:Char):Boolean;πFunction Read_Ahead(Port:Byte):Char;πFunction KeyRead_Nowait:Word;πFunction Keyread:Word;πProcedure Flow_Control(Port:Byte; ControlMask:Byte);πFunction Abort_Control(Port:Byte; Flags:Byte):Word;πProcedure Set_CursorXY(X,Y:Byte);πProcedure Get_CursorLoc(Var X,Y:Byte);πProcedure ANSI_Write(OutChar:Char);πProcedure Watchdog(Port:Byte; CarrierWatch:Boolean);πProcedure BIOS_Write(OutChar:Char);πFunction TimerChain(Add:Boolean; FunctionSeg:Word; FunctionOfs:Word):Boolean;πProcedure System_Reboot(ColdBoot:Boolean);πFunction ReadBlock(Port:Byte; MaxBytes:Word; Var Buffer):Word;πFunction WriteBlock(Port:Byte; MaxBytes:Word; Var Buffer):Word;πProcedure SendBreak(Port:Byte; SendOn:Boolean);πProcedure Driver_Info(Port:Byte; Var FossilInfo:DriverInfo);πFunction Install_Application(CodeNum:Byte; EntrySeg:Word; EntryOfs:Word):Boolean;πFunction Remove_Application(CodeNum:Byte; EntrySeg:Word; EntryOfs:Word):Boolean;ππimplementationππFunction Port_Status;πBeginπRegs.AH := $03;πRegs.DX := Port;πIntr($14,Regs);πPort_Status := Regs.AX;πEnd;ππProcedure Set_Baud; (* Speed 2 = 300 Baud *)π (* 3 = 600 Baud *)πBegin (* 4 = 1200 Baud *)π Regs.AL := (Speed SHL 5) + 3; (* 5 = 2400 Baud *)π Regs.DX := Port; (* 6 = 4800 Baud *)π Intr($14,Regs); (* 7 = 9600 Baud *)π (* 0 = 19200 Baud *)πEnd; (* 1 = 38400 Baud *)ππFunction Xmit;πBegin (* Send One character to the Port *)π Regs.AH := $01;π Regs.DX := Port;π Regs.AL := Ord(OutChar);π Intr($14,Regs);π Xmit := Regs.AX;πEnd;ππFunction CommWrite;πVarπ I : Byte; (* Uninterruptable string to the port *)π Len : Byte; (* If you're not going to look for keystrokes *)π Stat : Byte; (* piling up in the buffer. This is a quick *)π Error : Byte; (* way to send a whole string to the port *)ππBeginπ Len := Length(OutString);π Stat := 128;π I := 1;π While (I < Len) and ((Stat AND 128) = 128) Doπ Beginπ Regs.AH := $01;π Regs.AL := Ord(OutString[I]);π Regs.DX := Port;π Intr($14,Regs);π Stat := Regs.AL;π Inc(I);π End;πCommWrite := Port_Status(Port);πEnd;ππFunction CommRead; (* Read one character waiting at *)πBegin (* the comm port *)πRegs.AH := $02;πRegs.DX := Port;πIntr($14,Regs);πCommRead := Chr(Regs.AL);πEnd;ππFunction Init_Fossil; (* Initialize the fossil driver *)π (* Raise DTR and prepare out/in *)π (* buffers for communications *)πBeginπRegs.AH := $04;πRegs.DX := Port;πIf BreakAddr > 0 Thenπ Beginπ Regs.BX := $4F50;π Regs.CX := BreakAddr;π End;πIntr($14,Regs);πMaxFunctionNum := Regs.BL;πRevDoc := Regs.BH;πInit_Fossil := Regs.AX;πEnd;ππProcedure DeInit_Fossil; (* Tell Fossil that comm *)πBegin (* Operations are ended *)πRegs.AH := $05;πRegs.DX := Port;πIntr($14,Regs);πEnd;ππProcedure ModemDTR; (* RAISE/Lower Modem DTR *)πBegin (* DTRUp = True DTR is UP *)πRegs.AH := $06;πRegs.DX := Port;πIf DTRUp Then Regs.AL := 1π Else Regs.AL := 0;πIntr($14,Regs);πEnd;ππProcedure Get_Timer_Data; (* Return Timing Info *)πBeginπRegs.AH := $07;πIntr($14,Regs);πInterruptNum := Regs.AL;πTicksPerSec := Regs.AH;πMillisecsPer := Regs.DX;πEnd;ππProcedure Flush_Output_Buffer; (* Send any remaining Data *)πBeginπRegs.AH := $08;πRegs.DX := Port;πIntr($14,Regs);πEnd;ππProcedure Purge_Output_Buffer; (* Discard Data In Buffer *)πBeginπRegs.AH := $09;πRegs.DX := Port;πIntr($14,Regs);πEnd;ππProcedure Purge_Input_Buffer;πBegin (* Discard all pending Input *)πRegs.AH := $0A;πRegs.DX := Port;πIntr($14,Regs);πEnd;ππFunction Xmit_Nowait;πBegin (* Send character Unbuffered to *)πRegs.AH := $0B; (* port. Returns true if op was *)πRegs.DX := Port; (* successful (there was room in *)πRegs.AL := Ord(OutChar); (* the output buffer) *)πIntr($14,Regs);πIf Regs.AX = 1 Then Xmit_NoWait := Trueπ Else Xmit_NoWait := False;πEnd;ππFunction Read_Ahead; (* See what character is waiting *)πBegin (* in the buffer without reading *)πRegs.AH := $0C; (* it out. * PEEK * *)πRegs.DX := Port;πIntr($14,Regs);πRead_Ahead := Chr(Regs.AX);πEnd;ππFunction KeyRead_Nowait; (* Does not wait for keypressed *)πBegin (* Returns $FFFF if no key is *)πRegs.AH := $0D; (* waiting. Acts as "standard" *)πIntr($14,Regs); (* keyscan-- ScanCode in high *)πKeyread_Nowait := Regs.AX; (* order byte -- character in *)πEnd; (* low byte *)ππFunction Keyread; (* As above but waits for key *)πBeginπRegs.AH := $0E;πIntr($14,Regs);πKeyRead := Regs.AX;πEnd;ππProcedure Flow_Control;πBegin (* Enable/Disable Flow Control *)πRegs.AH := $0F; (* ControlMask Values *)πRegs.DX := Port; (* 0 = Disable *)πRegs.AL := (ControlMask AND 15) + $F0; (* Bit 0 Set = Enable XON/XOFF Recv *)πIntr($14,Regs); (* Bit 1 Set = CTS/RTS *)πEnd; (* Bit 2 is reserved for DSR/DTR *)π (* Bit 3 Set = Enable XON/XOFF Send *)ππFunction Abort_Control;πBegin (* Not Well documented. *)πRegs.AH := $10; (* Flags = 1 Toggle ^C ^K chek *)πRegs.DX := Port; (* Flags = 2 Toggle Transmit ON/OFF *)πRegs.AL := Flags; (* Huh? I guess ON/OFF is stoping *)πIntr($14,Regs); (* data flow. The present flag val *)πAbort_Control := Regs.AX; (* is stored and returned on the *)πEnd; (* next call to this function *)ππProcedure Set_CursorXY; (* Set Cursor Location *)πBegin (* X,Y is 0 relative X=Col Y=Row *)πRegs.AH := $11; (* I'm not sure if it just sets the *)πRegs.DH := Y; (* cursor on the screen or produces *)πRegs.DL := X; (* ANSI codes to do it on the remote *)πIntr($14,Regs); (* I assume since there is no port *)πEnd; (* that it is just the local term *)ππProcedure Get_CursorLoc; (* Zero Relative as above *)πBeginπRegs.AH := $12;πIntr($14,Regs);πY:= Regs.DH;πX:= Regs.DL;πEnd;ππProcedure ANSI_Write; (* Character to Screen Routed thru *)πBegin (* ANSI.SYS *)πRegs.AH := $13;πRegs.AL := Ord(OutChar);πIntr($14,Regs);πEnd;ππProcedure Watchdog;πBegin (* CarrierWatch = True Reboot on *)πRegs.AH := $14; (* Carrier Loss. *)πRegs.DX := Port;πIf CarrierWatch Then Regs.AL := 1π Else Regs.AL := 0;πIntr($14,Regs);πEnd;ππProcedure BIOS_Write; (* BIOS write to the screen *)πBeginπRegs.AH := $15;πRegs.AL := Ord(OutChar);πIntr($14,Regs);πEnd;ππFunction TimerChain; (* Add/Delete function from timer *)π (* Chain. Creates or deletes from *)π (* dynamic list of function addr's *)πBegin (* to be exec'd during timer proc *)πRegs.AH := $16;πRegs.ES := FunctionSeg;πRegs.DX := FunctionOfs;πIf Add Then Regs.AL := 1π Else Regs.AL := 0;πIntr($14,Regs);πIf Regs.AX = $FFFF Then TimerChain := Falseπ Else TimerChain := True;πEnd;ππProcedure System_Reboot; (* Reboot System, *)πBegin (* ColdBoot = True = Hard Reset *)πRegs.AH := $17; (* Coldboot = False = BootStrap *)πIf Coldboot Then Regs.AL := 0π Else Regs.AL := 1;πIntr($14,regs);πEnd;ππFunction ReadBlock; (* Reads Communications Buffer *)π (* Into the Untyped Array Buffer *)π (* Maxbytes is the size of the array *)π (* Returns the number of Bytes *)π (* Actually Sent *)πBeginπRegs.AH := $18;πRegs.DX := Port;πRegs.CX := MaxBytes;πRegs.ES := OFS(Buffer);πRegs.DI := Seg(Buffer);πIntr($14,Regs);πReadBlock := Regs.AX;πEnd;ππFunction WriteBlock; (* Writes To Communications buffer *)π (* From the Untyped Array Buffer. *)π (* Maxbytes is the size of the array *)πVar (* Returns the number of Bytes *)π BufferAddr : Byte Absolute Buffer; (* Actually Sent *)ππBeginπRegs.AH := $19;πRegs.DX := Port;πRegs.CX := MaxBytes;πRegs.ES := OFS(BufferAddr);πRegs.DI := Seg(BufferAddr);πIntr($14,Regs);πWriteBlock := Regs.AX;πEnd;ππProcedure SendBreak; (* Send Break to Port til *)πBegin (* Called With SendON = F *)πRegs.AH := $1A;πRegs.DX := Port;πIf SendOn Then Regs.AL := 1π Else Regs.AL := 0;πIntr($14,Regs);πEnd;ππProcedure Driver_Info;πVarπ Temp : String[80]; (* Return Driver Information in record *)π Segment : Word; (* Structure Type of DriverInfo *)π OffSet : Word;π InputChr : Char;ππBeginπRegs.AH := $1B;πRegs.DX := Port;πRegs.ES := Seg(FossilInfo);πRegs.DI := Ofs(FossilInfo);πRegs.CX := SizeOf(FossilInfo);πIntr($14,Regs);πSegment := FossilInfo.IdPtr[2];πOffSet := FossilInfo.IdPtr[1];πTemp := '';πInputChr := ' ';πWhile Ord(InputChr) <> 0 Doπ Beginπ InputChr := Chr(Mem[Segment:OffSet]);π Inc(OffSet);π Temp := Temp + InputChr;π End;πFossilInfo.DriverName := Temp;πEnd;ππFunction Install_Application;πBeginπRegs.AH := $7E;πRegs.AL := CodeNum;πRegs.DX := EntryOfs;πRegs.DS := EntrySeg;πIntr($14,Regs);πIf (Regs.AX = $1954) and (Regs.BH = 1) Then Install_Application := Trueπ Else Install_Application := False;πEnd;ππFunction Remove_Application;πBeginπRegs.AH := $7F;πRegs.AL := Codenum;πRegs.DX := EntryOfs;πRegs.DS := EntrySeg;πIntr($14,Regs);πIf (Regs.AX = $1954) and (Regs.BH = 1) Then Remove_Application := Trueπ Else Remove_Application := False;πEnd;πEnd.π 50 08-24-9413:40ALL KRISTO KIVISAAR Fossil Engine SWAG9408 7≥Γ∩ 70 ╣J πUNIT FossilP; { see demo at end of code }ππINTERFACEππUses Dos, Crt; { Phone, PXEngine, PxMsg; Config;}ππTypeπ FossilInfo = Recordπ MaxFunc :Byte; {Max func number supported}π Revision :Byte; {Fossil revision supported}π MajVer :Byte; {Major version}π MinVer :Byte; {Minor version}π Ident :PChar; {Null terminated ID string}π IBufr :Word; {size of input buffer}π IFree :Word; {number of bytes left in buffer}π OBufr :Word; {size of output buffer}π OFree :Word; {number of bytes left in buffer}π SWidth :Byte; {width of screen}π SHeight :Byte; {height of screen}π Baud :Byte; {ACTUAL baud rate, computer to modem}π End;ππ FossilInfo2 = Recordπ StrucSize :Word; {Structure size in bytes}π MajVer :Byte; {Major version}π MinVer :Byte; {Minor version}π Ident :PChar; {Null terminated ID string}π IBufr :Word; {size of input buffer}π IFree :Word; {number of bytes left in buffer}π OBufr :Word; {size of output buffer}π OFree :Word; {number of bytes left in buffer}π SWidth :Byte; {width of screen}π SHeight :Byte; {height of screen}π Baud :Byte; {ACTUAL baud rate, computer to modem}π End;ππProcedure ModemSetting(Baud, DataBit: Integer; Party: Char; StopBit: Integer);πFunction FReadKey:Word;πProcedure FossilInt(var R:Registers);πProcedure GetFossilInfo(var FosRec:FossilInfo2; Port:Word);πProcedure InitFossil(var FosInf:FossilInfo; Port:Word);πProcedure DeInitFossil(Port:Word);πFunction FIsKeyPressed:Word;πFunction FossilReadChar(Port:Word):Byte;πFunction FossilIsCharReady(Port:Word):Word;πFunction FossilSendChar(Port:Word; Char:byte):Word;πProcedure Init;πProcedure FossilSendStr(S:String; Port:Word);πProcedure DialNo(Port:Word);πProcedure Run;πProcedure Done;ππProcedure WriteAnsi;πProcedure HangUp;πProcedure DialRec(Port:Word);ππIMPLEMENTATIONππ{ Fossil Functions }πProcedure FossilInt(var R:Registers);πbeginπ Intr($14,R);πEnd;ππProcedure ModemSetting(Baud, DataBit: Integer; Party: Char; StopBit: Integer);πVar Out : Integer;π R : Registers;π Port: Word;πBeginπOut := 0;πCase Baud Ofπ 0 :Exit;π 100 :Out := Out + 000 + 00 + 00;π 150 :Out := Out + 000 + 00 + 32;π 300 :Out := Out + 000 + 64 + 00;π 1200 :Out := Out + 128 + 00 + 00;π 2400 :Out := Out + 128 + 00 + 32;π 4800 :Out := Out + 128 + 64 + 00;π 9600 :Out := Out + 128 + 64 + 32;πEnd;πCase DataBit Ofπ 5 :Out := Out + 0 + 0;π 6 :Out := Out + 0 + 1;π 7 :Out := Out + 2 + 0;π 8 :Out := Out + 2 + 1;πEnd;πCase Party Ofπ 'N' :Out := Out + 00 + 0;π 'O', 'o' :Out := Out + 00 + 8;π 'n' :Out := Out + 16 + 0;π 'E', 'e' :Out := Out + 16 + 8;πEnd;πCase StopBit Ofπ 1 :Out := Out + 0;π 2 :Out := Out + 4;πEnd;πR.AH:=0;πR.AL:=Out;πR.DX:=Port;πFossilInt(R);πEnd;ππProcedure GetFossilInfo(var FosRec:FossilInfo2; Port:Word);πVarπ R: Registers;πBeginπ R.AH:=$1B; {Function number 1bh}π R.CX:=SizeOf(FosRec); {size of user info}π R.DX:=Port; {port number}π R.ES:=Seg(FosRec); {segment of info buf}π R.DI:=Ofs(FosRec); {offset of info buf}π FossilInt(R);πEnd;ππProcedure InitFossil(var FosInf:FossilInfo; Port:Word);πVarπ R :Registers;π Z :FossilInfo2;πBeginπ R.AH:=$04;π R.DX:=Port;π FossilInt(R);π if R.AX=$1954 then begin {AX should countain 1954h if fossil is loaded}π FosInf.MaxFunc :=R.BL;π FosInf.Revision:=R.BH;π GetFossilInfo(Z,Port);π with FosInf do beginπ MajVer:= Z.MajVer;π MinVer:= Z.MinVer;π Ident := Z.Ident;π IBufr := Z.IBufr;π IFree := Z.IFree;π OBufr := Z.OBufr;π OFree := Z.OFree;π SWidth:= Z.SWidth;π SHeight:=Z.SHeight;π Baud := Z.Baud;π End;π End Else FosInf.MaxFunc:=0; {MaxFunc contains 0 if fossil is not found}πEnd;ππProcedure DeInitFossil(Port:Word);πvarπ R: Registers;πBeginπ R.AH:=$05;π R.DX:=Port;π FossilInt(R);πEnd;ππFunction FIsKeyPressed:Word;πvarπ R:Registers;πBeginπ R.AH:=$0D;π FossilInt(R);π FIsKeyPressed := R.AX;πEnd;ππFunction FReadKey:Word;πvarπ R:Registers;πBeginπ R.AH:=$0E;π FossilInt(R);π FReadKey := R.AX;πEnd;ππFunction FossilReadChar(Port:Word):Byte;πvarπ R :Registers;πBeginπ R.AH:=$02;π R.DX:=Port;π FossilInt(R);π FossilReadChar := R.ALπEnd;ππFunction FossilIsCharReady(Port:Word):Word;πvarπ R :Registers;πBeginπ R.AH:=$0C;π R.DX:=Port;π FossilInt(R);π FossilIsCharReady := R.AX;πEnd;ππFunction FossilSendChar(Port:Word; Char:byte):Word;πvarπ R :Registers;πBeginπ R.AH:=$01;π R.DX:=Port;π R.AL:=Char;π FossilInt(R);π FossilSendChar := R.AX;πEnd;ππConstπ CurPort :Word = 1; {current COM port of modem}ππ ExitKey=$2d00; {ALT-X}π DialKey=$2000; {ALT-D}ππ DialPref:String ='ATDT';π DialSuf :String =#13;ππVarπ Z :FossilInfo;ππProcedure Init;πBeginπ Write('Modem Port(0=COM1):');π ReadLn(CurPort);π InitFossil(Z,CurPort);π if Z.MaxFunc=0 then beginπ WriteLn('ERROR:No FOSSIL driver found!');π Sound(400);π Delay(500);π NoSound;π Halt(1);π End;π WriteLn('Fossil: Rev ',Z.Revision,' ',Z.Ident);πEnd;πππProcedure FossilSendStr(S:String; Port:Word);πVarπ I:Byte;πBeginπ for I:=1 to byte(S[0]) do FossilSendChar(Port,byte(S[I]));πEnd;ππProcedure DialNo(Port:Word);πConst SufixDial = 'ATDT';πvarπ TelNo:String;πBeginπ WriteLn;π Write('Number to dial:');π ReadLn(TelNo);π if TelNo<>'' then beginπ TelNo := SufixDial+TelNo+DialSuf;π FossilSendStr(TelNo,Port);π end;πend;πππProcedure DialRec(Port:Word);πvarπ SufixDial : String;π Num : Integer;π BBSName : String;π BBSNumber : String;π Password : String;π Speed : Integer;π TelNo : String;πBeginπWriteln('TelNo is ',TelNo);πTelNo := 'ATDT'+TelNo+DialSuf;πFossilSendStr(TelNo,Port);πEnd;ππProcedure Run;πvarπ Key :Word;π Done:Boolean;πBeginπ Done := False;π Repeatπ If FossilIsCharReady(1)<>$FFFF Then Beginπ Write(Chr(FossilReadChar(CurPort)));π End;π If FIsKeyPressed<>$FFFF Then Beginπ Key:=FReadKey;π Case Key Ofπ ExitKey:Done:=True;π DialKey:DialNo(CurPort);π Else FossilSendChar(CurPort,Lo(Key));π End;ππ End;π Until Done;πEnd;ππProcedure WriteAnsi;πVar R : registers;πBeginπ R.AH := $13;π R.AL := ORD(FossilreadChar(CurPort));π Intr($14, R);πEnd;ππProcedure HangUp;πBeginπ FossilSendSTR('+++',CurPort);π FossilSendSTR('ATH0'+#13, CurPort);πEnd;ππProcedure Done;πBeginπ DeInitFossil(CurPort);πEnd;ππEnd.ππ{ -------------------------------- DEMO PROGRAM --------------------- }ππ{$M 65520,65520,65520}πProgram AnsiEmu;ππUses Dos, Crt, FossilP;πConst CurPort :Word=1;ππ ExitKey = $2d00; {ALT-X}π DialKey = $2000; {ALT-D}π HangUpKey = $2300; {ALT-H}π DownLoadKey = $2004; {CTRL+D}π UpLoadKey = $1615; {CTRL+U}π ChangeSetUp = $2100; {ALT+F}π Menuu = $2E00; {ALT+C}π PgUp = $4900; {PageUp}π PgDown = $5100; {PageDown}π ReadPhon = $1900; {ALT+P}πππ DialPref :String='ATDT';π DialSuf :String=#13;πππVar Key : Word;π Done : Boolean;π AnsiM : Char;ππ{ZMODEM'iga download}πProcedure DownLoadZ;πBeginπSwapVectors;πExec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 rz');πSwapVectors;πEnd;ππProcedure UpLoadZ;πVar FileName : String;πBeginπWrite('Millist faili tahad Uppida: ');πReadln(FileName);πSwapVectors;πExec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 sz '+FileName);πSwapVectors;πEnd;ππProcedure FirstKey;πVar Vastus : Byte;πBeginπClrScr;πTextColor(red);πWriteln('Millist Protocolli kasutad: ');πWriteln;πWriteln('1. Zmodem');πWriteln('2. Puma ');πWriteln('3. SeaLink');πWriteln;πWrite('Vastus: ');πReadln(Vastus);π Case Vastus ofπ 1 : DownLoadZ;π End; {End Case}πTextColor(White);πEnd;ππProcedure DownLoad;πBeginπSwapVectors;π Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 rz');πSwapVectors;πEnd;ππProcedure UpLoad;πVar FileName : String;πBeginπ Write('Enter Filename to UpLoad: ');π Readln(FileName);π SwapVectors;π Exec(GetEnv('COMSPEC'), '/C' + 'c:\gsz.exe port 2 sz '+FileName);π SwapVectors;πEnd;ππBeginπClrScr;πTextColor(White);πInit;π Done:=False;π Repeatπ If FossilIsCharReady(1)<>$FFFF then beginπ {Write(Chr(FossilReadChar(CurPort)));}π WriteAnsi; {If ANSI loaded then color else BW}π End;π if FIsKeyPressed<>$FFFF then beginπ Key:=FReadKey;π case Key ofπ ExitKey : Done:=True;π DialKey : DialNo(CurPort);π HangUpKey : HangUp;π DownLoadKey: DownLoadZ;π UpLoadKey : UpLoadZ;π PgDown : FirstKey; {DownLoadSeaLink;}π PgUp : UpLoad;ππ Else FossilSendChar(CurPort, Lo(Key));π End;π End;π Until Done;ππ Writeln('The End :-)');π{PXDone;}πTextColor(White);πEnd.ππ 51 08-24-9413:52ALL JOHN STEPHENSON Flushing Fossil Buffers SWAG9408 │nU 3 ╣J πProcedure PurgeInput; assembler;π{ Purges the input buffer -- Empties it into obilivion! }πasmπ mov AH, $0Aπ mov DX, portπ Int $14πEnd;ππππ 52 08-24-9413:55ALL JASON DYER RIP Graphics SWAG9408 ┐└ê~ 110 ╣J π{ RIPSEE.PAS version 1.0 views a RIP 1.54 in EGAπPublic domain by Jason Dyer, use is free, but it would be nice if you gaveπme credit. Netmail at jason.dyer@solitud.fidonet.org on Internet or 1:300/23πon Fidonet. If anyone can tell me the REAL way to scroll the graphic part ofπthe screen please tell me.πThis program assumes you have TP/BP 7.0+ because of the new fonts it adds.πIf you are using anything less you will have to add the new fonts manually.πAlso, the icon format is different...the "trash byte" isn't used in 6.0.πA few things are missing, like mouse buttons and the text window...expectπthem in a later version. }ππPROGRAM RipSee;ππUSES Crt, Dos, Graph;ππCONST Place : ARRAY [1..5] OF LONGINT = (1, 36, 1296, 46656, 1679616);π Seq = ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ');ππVAR ErrorCode : INTEGER;π GrDriver, GrMode : INTEGER;π f : TEXT;π SSS : STRING;π ccol : INTEGER;π Ch : CHAR;π Clipboard : POINTER;π LLL : INTEGER;π command : STRING;π RipLine, bslash : BOOLEAN;ππFUNCTION FileExists (zzz : STRING) : BOOLEAN;πVAR DoCheck : SearchRec;πBEGINπ FINDFIRST (zzz, AnyFile, DoCheck);π IF DosError = 0 THEN FileExists := TRUE ELSE FileExists := FALSE;πEND;ππPROCEDURE WriteString (SSS : STRING; CP : INTEGER);πVAR Prloop : INTEGER;π Regs : REGISTERS;πBEGINπ regs.ah := $0E;π regs.bh := 0;π regs.bl := cp;π FOR PrLoop := 1 TO LENGTH (SSS) DO BEGINπ Regs.Al := ORD (SSS [PrLoop]);π INTR ($10, Regs);π END;πEND;ππFUNCTION Convert (SS : STRING) : LONGINT;πVAR PrLoop, Counter : INTEGER;π CA, Tag : LONGINT;πBEGINπ IF LENGTH (ss) = 1 THEN ss := '0' + ss;π Counter := 0; CA := 0;π FOR PrLoop := LENGTH (SS) DOWNTO 1 DO BEGINπ Counter := Counter + 1;π Tag := POS (SS [PrLoop], Seq) - 1;π CA := CA + (Tag * Place [Counter]);π END;π Convert := CA;πEND;ππPROCEDURE DrawBezierCurve (px1, py1, px2, py2, px3, py3, px4, py4, count : INTEGER);πFUNCTION pow (x : REAL; y : WORD) : REAL;πVARπ nt : WORD;π result : REAL;πBEGINπ result := 1;π FOR nt := 1 TO y DOπ result := result * x;π pow := result;πEND;ππPROCEDURE Bezier (t : REAL; VAR x, y : INTEGER);πBEGINπ x := TRUNC (pow (1 - t, 3) * px1 + 3 * t * pow (1 - t, 2) * px2 +π 3 * t * t * (1 - t) * px3 + pow (t, 3) * px4);π y := TRUNC (pow (1 - t, 3) * py1 + 3 * t * pow (1 - t, 2) * py2 +π 3 * t * t * (1 - t) * py3 + pow (t, 3) * py4);πEND;πVARπ resolution, t : REAL;π xc, yc : INTEGER;πBEGINπ IF count = 0 THEN EXIT;π resolution := 1 / count;π MOVETO (px1, py1);π t := 0;π WHILE t < 1 DO BEGINπ Bezier (t, xc, yc);π LINETO (xc, yc);π t := t + resolution;π END;π LINETO (px4, py4);πEND;ππPROCEDURE Scrollgraph (x1, y1, x2, y2, dest : INTEGER);πVAR PP : POINTER;πBEGINπ IF x1 MOD 8 <> 0 THEN x1 := x1 DIV 8;π IF x2 MOD 8 <> 0 THEN x2 := (x2 + 8) DIV 8;π GETMEM (pp, IMAGESIZE (x1, y1, x2, y2) );π GETIMAGE (x1, y1, x2, y2, pp^);π PUTIMAGE (x1, dest, pp^, 0);π DISPOSE (pp);πEND;ππPROCEDURE ResetWindows;πBEGINπ SETVIEWPORT (0, 0, GETMAXX, GETMAXY, ClipOn);π CLEARDEVICE; IF clipboard <> NIL THEN DISPOSE (clipboard);π clipboard := NIL;πEND;ππPROCEDURE usersetf;πVAR ii, jj : INTEGER;π zz : FillPatternType;πBEGINπ jj := 0;π FOR ii := 1 TO 8 DO BEGINπ jj := jj + 2;π zz [ii] := Convert (COPY (command, jj, 2) );π END;π SETFILLPATTERN (zz, Convert (COPY (command, 18, 2) ) );πEND;ππPROCEDURE DPoly (fillit, ifpoly : BOOLEAN; np : INTEGER);πVAR ii, zz, yy : INTEGER;π poly : ARRAY [1..200] OF PointType;πBEGINπ ii := 4;π FOR zz := 1 TO np DO BEGINπ poly [zz].x := Convert (COPY (command, ii, 2) );π poly [zz].y := Convert (COPY (command, ii + 2, 2) );π ii := ii + 4;π END; IF ifpoly THEN BEGINπ poly [np + 1] := poly [1];π IF NOT fillit THEN DRAWPOLY (np + 1, poly) ELSE FILLPOLY (np + 1, poly);π END ELSE IF NOT fillit THEN DRAWPOLY (np, poly) ELSE FILLPOLY (np, poly);πEND;ππPROCEDURE toclip (x1, y1, x2, y2 : INTEGER);πBEGINπ IF clipboard <> NIL THEN DISPOSE (clipboard);π GETMEM (clipboard, IMAGESIZE (x1, y1, x2, y2) );π GETIMAGE (x1, y1, x2, y2, ClipBoard^);πEND;ππPROCEDURE LoadIcon (x, y, mode, cboard : INTEGER; fname : STRING);πVAR fi : FILE;π P : POINTER;π Z : LONGINT;π tt : TextSettingsType;π cc : WORD;πBEGINπ IF NOT fileexists (fname) THEN BEGINπ IF cboard = 1 THEN clipboard := NIL;π GETTEXTSETTINGS (tt); cc := GETCOLOR;π SETTEXTSTYLE (DefaultFont, HorizDir, 1); SETCOLOR (15);π OUTTEXTXY (x, y, Fname);π OUTTEXTXY (x, y + TEXTHEIGHT (Fname), 'not found');π SETCOLOR (cc); SETTEXTSTYLE (tt.font, tt.direction, tt.charsize);π END ELSE BEGINπ ASSIGN (fi, fname); NEW (P);π RESET (fi);π z := FILESIZE (fi);π GETMEM (P, FILESIZE (fi) );π BLOCKREAD (fi, P^, FILESIZE (fi) );π CLOSE (fi);π IF cboard = 1 THEN clipboard := p;π PUTIMAGE (x, y, p^, mode);π DISPOSE (p);π END;πEND;ππPROCEDURE allpalette;πVAR Pal : PaletteType;π ii, jj : INTEGER;πBEGINπ Pal.Size := 16;π jj := 0;π FOR ii := 1 TO 16 DO BEGINπ jj := jj + 2;π Pal.Colors [ii - 1] := Convert (COPY (command, jj, 2) );π END;π SETALLPALETTE (Pal);πEND;ππPROCEDURE ParseCommand (command : STRING);πBEGINπ IF command = '*' THEN resetwindows;π IF command [1] = 'W' THEN SetWriteMode (Convert (COPY (command, 2, 2) ) );π IF command [1] = 'S' THEN SETFILLSTYLE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ) );π IF command [1] = 'E' THEN CLEARVIEWPORT;π IF command [1] = 'v' THEN SETVIEWPORT (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ), ClipOn);π IF command [1] = 'c' THEN IF LENGTH (command) = 2 THENπ BEGIN ccol := (POS (command [2], Seq) - 1); SETCOLOR (ccol); ENDπ ELSE BEGIN ccol := (Convert (COPY (command, 2, 2) ) ); SETCOLOR (ccol); END;π IF command [1] = 'Y' THEN SETTEXTSTYLE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ) );π IF command [1] = 's' THEN usersetf;π IF command [1] = 'Q' THEN allpalette;π IF command [1] = '@' THEN OUTTEXTXY (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π COPY (command, 6, LENGTH (command) - 5) );π IF command [1] = 'F' THEN FLOODFILL (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ) );π IF command [1] = 'C' THEN CIRCLE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ) );π IF command [1] = 'B' THEN BAR (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ) );π IF command [1] = 'A' THEN ARC (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ),π Convert (COPY (command, 10, 2) ) );π IF command [1] = 'I' THEN PIESLICE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ),π Convert (COPY (command, 10, 2) ) );π IF command [1] = 'i' THEN Sector (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ),π Convert (COPY (command, 10, 2) ),π Convert (COPY (command, 12, 2) ) );π IF command [1] = 'L' THEN LINE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ) );π IF command [1] = 'R' THEN RECTANGLE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ) );π IF command [1] = 'o' THEN FillEllipse (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ) );π IF (command [1] = 'O') OR (command [1] = 'V') THENπ ELLIPSE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ),π Convert (COPY (command, 10, 2) ),π Convert (COPY (command, 12, 2) ) );π IF command [1] = 'P' THEN Dpoly (FALSE, TRUE, Convert (COPY (command, 2, 2) ) );π IF command [1] = 'p' THEN Dpoly (TRUE, TRUE, Convert (COPY (command, 2, 2) ) );π IF command [1] = 'X' THEN PUTPIXEL (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ), ccol);π IF command [1] = 'a' THEN SETPALETTE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ) );π IF command [1] = '=' THEN SETLINESTYLE (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 4) ),π Convert (COPY (command, 8, 2) ) );π IF command [1] = 'l' THEN Dpoly (FALSE, FALSE, Convert (COPY (command, 2, 2) ) );π IF command [1] = 'Z' THEN DrawBezierCurve (Convert (COPY (command, 2, 2) ),π Convert (COPY (command, 4, 2) ),π Convert (COPY (command, 6, 2) ),π Convert (COPY (command, 8, 2) ),π Convert (COPY (command, 10, 2) ),π Convert (COPY (command, 12, 2) ),π Convert (COPY (command, 14, 2) ),π Convert (COPY (command, 16, 2) ),π Convert (COPY (command, 18, 2) ) );π IF command [1] = '1' THEN BEGIN {level one commands}π IF command [2] = 'C' THEN Toclip (Convert (COPY (command, 3, 2) ),π Convert (COPY (command, 5, 2) ),π Convert (COPY (command, 7, 2) ),π Convert (COPY (command, 9, 2) ) );π IF (command [2] = 'P') AND (Clipboard <> NIL)π THEN PUTIMAGE (Convert (COPY (command, 3, 2) ),π Convert (COPY (command, 5, 2) ),π Clipboard^,π Convert (COPY (command, 7, 2) ) );π IF command [2] = 'I' THEN LoadIcon (Convert (COPY (command, 3, 2) ),π Convert (COPY (command, 5, 2) ),π Convert (COPY (command, 7, 2) ),π Convert (COPY (command, 9, 1) ),π COPY (command, 12, LENGTH (command) - 11) );π IF command [2] = 'G' THEN Scrollgraph (Convert (COPY (command, 3, 2) ),π Convert (COPY (command, 5, 2) ),π Convert (COPY (command, 7, 2) ),π Convert (COPY (command, 9, 2) ),π Convert (COPY (command, 13, 2) ) );π END;πEND;ππPROCEDURE Init;πVAR FName : STRING;πBEGINπ clipboard := NIL;π DETECTGRAPH (GrDriver, Grmode);π IF GrDriver < 3 THEN BEGINπ WRITELN ('EGA not detected!');π HALT (1);π END; GrMode := vgahi; Grdriver := vga;π INITGRAPH (GrDriver, GrMode, '\turbo\tp'); { The address of your BGI files }π ErrorCode := GRAPHRESULT;π IF ErrorCode <> grOK THENπ BEGINπ WRITELN ('Graphics error:');π WRITELN (GraphErrorMsg (ErrorCode) );π WRITELN ('Program aborted...');π HALT (1);π END;π Fname := PARAMSTR (1);π IF POS ('.', Fname) = 0 THEN Fname := Fname + '.RIP';π IF (NOT FileExists (Fname) ) OR (Fname = '.RIP') THEN BEGINπ WRITELN ('File not found!');π HALT (1);π END;π CLEARDEVICE; LLL := 0; command := ''; bslash := FALSE;π ASSIGN (f, Fname); ripline := FALSE; RESET (f);πEND;ππBEGINπ Init;π REPEATπ READ (f, Ch);π IF (ORD (ch) = 13) OR (ORD (ch) = 10) THEN BEGINπ IF bslash = TRUE THEN BEGIN READ (f, ch); bslash := FALSE;π END ELSE BEGINπ LLL := 0; READ (f, ch);π IF ripline = TRUE THEN ripline := FALSE ELSEπ WriteString (ch, 15);π END;π END ELSE BEGINπ LLL := LLL + 1;π IF (LLL = 1) AND (Ch = '!') THEN ripline := TRUE ELSE BEGINπ IF ripline THEN BEGINπ CASE ch OFπ '|' : BEGINπ IF bslash THEN BEGIN command := command + ch; bslash := FALSE; END ELSEπ BEGINπ IF command <> '' THEN ParseCommand (command);π command := '';π END;π END;π '\' : BEGINπ IF bslash THEN BEGIN command := command + ch; bslash := FALSE; END ELSEπ bslash := TRUE;π END;π ELSE command := command + ch;π END;π END ELSE BEGINπ WriteString (ch, 15);π END;π END;π END;π UNTIL EOF (f);π CLOSE (f);π IF command <> '' THEN ParseCommand (command);π Ch := READKEY;π CLOSEGRAPH;πEND.π 53 08-24-9413:56ALL WAYNE BOYD SuperFossil SWAG9408 &w╖Y 124 ╣J (* ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ *)π (* ░░██████░░░░░░░░░░░░░░░░░░░░░██████░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ *)π (* ░░█ ░░░░░░░░░░░░░░░░░░░░█ ░░░░░░░░░░· ·░░░░░ *)π (* ░░██████ █░░█░████░█▀▀█░█▄██░███░░████░█▀▀▀░░░ By Wayne Boyd ▒░░░░ *)π (* ░░░ █ █ ░█ █ █ █▀▀▀ █ █ ░█ █ ▀▀▀█░░░ Fido 1:153/763 ▒░░░░ *)π (* ░░██████ ████ ████ ████ █ ░░░█ ░░░████ ████ ░░· ·▒░░░░ *)π (* ░░░ ░ █ ░ ░ ░░░░ ░░░░ ░ ░░░▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒░░░░ *)π (* ░░░░░░░░░░░░░░█ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░ ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░░░░░░░· A Turbo Pascal Unit for ·░░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░░░░░░░ modem communications using ▒░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░░░░░░░· a FOSSIL driver. ·▒░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒░░░░░░░░░░░░░░░░ *)π (* ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ *)π (* Welcome to my fossil driver world. After struggling for a long *)π (* time with various communications drivers I came to realize the *)π (* easiest way to go about writing doors and even BBS programs was to *)π (* use a FOSSIL driver. FOSSIL stands for Fido Opus Seadog Standard *)π (* Interface Layer. It's a TSR program that remains in your computer *)π (* memory and helps interface your software with the modem com port. *)π (* There's many BBS programs, Fidonet mailer's and On-line BBS games *)π (* that only operate with a FOSSIL driver loaded. The programs you *)π (* write with this unit will also depend on a FOSSIL driver. *)π (* Of course, there is no FOSSIL driver included with this package. *)π (* You have to pick one of those up on your own at most major *)π (* computer bulletin boards around country. I've tested this unit on *)π (* X00, BNU and OPUSCOMM and they work fine. The unit that is *)π (* included here is more a less a complete package. You could write a *)π (* BBS or a door with it easily. I've written many doors now, and *)π (* this is my standard unit. I don't want to claim credit for *)π (* everything here. In fact, the function calls used are from the *)π (* fossil revision 5 documentation and will work with any proper *)π (* FOSSIL driver. *)π (* *)π (* = It is important to note that this unit was specifically written to *)π (* = facilitate writing of BBS doors, but may be modified slightly to *)π (* = facilitate the writing of a BBS program itself. The difference is *)π (* = that generally when writing a door, if the caller drops carrier *)π (* = you would simply want the program to terminate and return to the *)π (* = BBS. In the case of a BBS, however, you want the BBS to recycle, *)π (* = not to terminate. Also, with some doors, rather than terminate *)π (* = immediately, you would want them to save information to file *)π (* = first. In such cases you have to modify all of the HALT statements *)π (* = that are found within this unit to reflect your actual needs. *)π (* *)π (* I have provided this unit as a public service for the BBS community, *)π (* but I do request that if you would like further support for programs *)π (* that you write with this unit, that you register this unit with me *)π (* by sending me a modest donation of $25.00. *)π (* *)π (* I may be contacted by writing: *)π (* ┌───────────────────────┐ *)π (* │ Wayne Boyd │ *)π (* │ c/o Vipramukhya Swami │ *)π (* │ 5462 SE Marine Drive │ *)π (* │ Burnaby, BC, V5J 3G8 │ *)π (* │ Canada │ *)π (* └───────────────────────┘ *)π (* My BBS is called Sita and the Ring BBS, and it is Fidonet node *)π (* 1:153/763, Transnet node 132:732/4 and ISKCONet 108:410/8. File *)π (* requests and netmail is acceptable. You may also log on my board at *)π (* 2400 baud or less, and the phone number is (604)431-6260. *)π (* *)ππUNIT SuperFos;ππINTERFACEππUSES Dos,Crt,ansi;π { this ANSI module is in ANSI.SWG. }πCONSTππ { These are defined global constants that can be passed to SetPort }ππ Com0 = 0; { local only mode }π Com1 = 1; { for COM1, etc. }π Com2 = 2;π Com3 = 3;π Com4 = 4;ππPROCEDURE SetPort(Port : Integer);π (* Set's ComPortNum to correct value, used by all procedures. Must be *)π (* called first. Use the defined constants to make it easy. For *)π (* example: SetPort(Com1) will assign COM1 as the input/output port. *)π (* In reality, the numeric value of ComPortNum is (Port - 1). *)π (* Calling SetPort with a 0 will cause all functions and *)π (* procedure to function in local mode. You must make one call to *)π (* SetPort at the beginning of your program before using any of the *)π (* procedures or functions in this unit. *)π (* *)π (* If you use *)π (* SetPort(Com0), all functions and procedures will function in local *)π (* mode, since Com0 = 0. This will cause the value of ComPortNum to *)π (* equal -1. *)ππPROCEDURE SetBaudRate(A : LongInt);π { Set baud rate, 300/600/1200/2400/4800/9600/19200/38400 supported}ππPROCEDURE TransmitChar(A : Char);π { Character is queued for transmission}ππFUNCTION TxCharNoWait(A : Char) : BOOLEAN;π { Try to send char. Returns true if sent, false if buffer full}ππFUNCTION ReceiveChar : Char;π { Next char in input buffer returned, waits if none avail}ππFUNCTION SerialStatus : Word;π{ AH bit 6, 1=output buffer emptyπ AH bit 5, 1=output buffer not fullπ AH bit 1, 1=input buffer overrunπ AH bit 0, 1=characters in input bufferπ AL bit 7, 1=carrier detectπ AL bit 3, 1=always}πFUNCTION KeyPressedPort : Boolean;π { Similar to KEYPRESSED. Returns TRUE if there is a character waiting inπ the input port. Uses the SerialStatus function above. }ππFUNCTION OutBufferFull : Boolean;π { Returns TRUE if the Output Buffer is full. }ππFUNCTION OutBufferEmpty : Boolean;π { Returns TRUE if the Output Buffer is empty. }ππFUNCTION OpenFossil : Boolean;π { Open & init fossil. Returns true if a fossil device is loaded }ππPROCEDURE CloseFossil;π { Disengage fossil from com port. DTR not changed}ππPROCEDURE SetDTR(A : Boolean);π { Raise or lower DTR}ππPROCEDURE FlushOutput;π { Wait for all output to complete}ππPROCEDURE PurgeOutput;π { Zero output buffer and return immediately. Chars in buffer lost}ππPROCEDURE PurgeInput;π { Zero input buffer and return immediately. Chars in buffer lost}ππFUNCTION CarrierDetect : Boolean;π { Returns true if there is carrier detect }ππFUNCTION SerialInput : Boolean;π { Returns true if there is a character ready to be input }ππPROCEDURE WriteChar(c : Char);π { Write char to screen only with ANSI support}ππPROCEDURE FlowControl(A : Byte);π { Enable/Disable com port flow control}ππPROCEDURE WritePort(s : string);π { Write string S to the comport and echo it to the screen. Checks if theπ buffer is full, and if it is, waits until it is available. If Carrier isπ dropped, this procedure will halt the program.}ππPROCEDURE WritelnPort(s : string);π { Same as WritePort, but adds a linefeed + CarrierReturn to the end of S }ππFUNCTION ReadKeyPort : char;π { Like pascal's Readkey.π Example:π varπ ch : char;π beginπ repeatπ ch := upcase(readkeyport);π until ch in ['Y','N'];π end.π}ππPROCEDURE ReadPort(var C : char);π { Similar to Pascal's Read(ch : char); This procedure will read theπ comport until a character is received. If no carrier is received itπ will wait and eventually time out. If carrier is dropped it will haltπ the program. The character is echoed to the local screen with ansiπ support.ππ EXAMPLEπ varπ ch : char;π beginπ ReadPort(Ch);π end.π}ππPROCEDURE ReadlnPort(var S : string);π { Similar to Pascal's Readln(s : string); This procedure will read theπ comport until a carriage return is received, and assign the value to S.π Carrier detect monitoring is enabled, and if the carrier is dropped theπ program will halt. Also there is a time out function. The charactersπ are echoed to the local screen with ansi support.ππ Example:π varπ Rspns : string;π beginπ ReadlnPort(Rspns); (* read a string from comport and store in Rspns *)π end.π}ππPROCEDURE HangUp;π { Hangs up on the caller by lowering DTR until carrier is dropped, and thenπ raising DTR again. }ππVARπ Reg : Registers; { Saves on stack usage later }ππ {-------------------------------------------------------------------------}ππIMPLEMENTATIONππConstπ TimeOut = 20000;ππVARπ Status : Word;π bt : byte;π ComPortNum : Integer;ππPROCEDURE SetPort(Port : Integer);πBEGINπ ComPortNum := Port - 1;πEND;ππFUNCTION BitOn(Position, TestByte : Byte) : Boolean;π {πThis function tests to see if a bit in TestByte is turned on (equal to one).πThe bit to test is indicated by the parameter Position, which can range from 0π(right-most bit) to 7 (left-most bit). If the bit indicated by Position isπturned on, the BitOn function returns TRUE.π}πBEGINπ bt := $01;π bt := bt SHL Position;π BitOn := (bt AND TestByte) > 0;πEND;ππPROCEDURE SetBaudRate(A : LongInt);πBEGINπ IF ComPortNum < 0 then exit;π WITH Reg DO BEGINπ AH := 0;π DX := ComPortNum;π AL := $63;π IF A=38400 THEN AL:=$23 ELSEπ CASE A OFπ 300 : AL := $43;π 600 : AL := $63;π 1200 : AL := $83;π 2400 : AL := $A3;π 4800 : AL := $C3;π 9600 : AL := $E3;π 19200 : AL := $03;π END;π Intr($14, Reg);π END;πEND;ππPROCEDURE TransmitChar(A : Char);πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := 1;π Reg.DX := ComPortNum;π Reg.AL := Ord(A);π Intr($14, Reg);πEND;ππFUNCTION TxCharNoWait(A : Char) : BOOLEAN;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := $0B;π Reg.DX := ComPortNum;π Intr($14,Reg);π TxCharNoWait := (Reg.AX = 1);πEND;ππFUNCTION ReceiveChar : Char;πBEGINπ IF ComPortNum < 0 then ReceiveChar := readkey elseπ beginπ Reg.AH := 2;π Reg.DX := ComPortNum;π Intr($14,Reg);π ReceiveChar := Chr(Reg.AL);π end;πEND;ππFUNCTION SerialStatus : Word;πBEGINπ Reg.AH := 3;π Reg.DX := ComPortNum;π Intr($14,Reg);π SerialStatus := Reg.AX;πEND;ππFUNCTION KeyPressedPort : Boolean;π {πSimilar to KEYPRESSED. Returns TRUE if there is a character waiting in theπinput port. Uses the SerialStatus function above.π}πVARπ Status : Word;π NextByte : byte;πbeginπ IF ComPortNum < 0 then KeyPressedPort := Keypressed elseπ beginπ Status := SerialStatus;π NextByte := hi(Status);π KeyPressedPort := BitOn(0,NextByte);π end;πend;ππFUNCTION OutBufferFull : Boolean;π { Returns TRUE if the Output Buffer is full. }πbeginπ IF ComPortNum < 0 then OutBufferFull := false elseπ beginπ Status := SerialStatus;π bt := hi(Status);π OutBufferFull := (BitOn(5,bt) = FALSE);π end;πend;ππFUNCTION OutBufferEmpty : Boolean;π { Returns TRUE if the Output Buffer is empty. }πbeginπ IF ComPortNum < 0 then OutBufferEmpty := true elseπ beginπ Status := SerialStatus;π bt := hi(Status);π OutBufferEmpty := BitOn(6,bt);π end;πend;ππFUNCTION OpenFossil : boolean;πBEGINπ if ComPortNum < 0 then OpenFossil := true elseπ beginπ Reg.AH := 4;π Reg.DX := ComPortNum;π Intr($14,Reg);π OpenFossil := Reg.AX = $1954;π end;πEND;ππPROCEDURE CloseFossil;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := 5;π Reg.DX := ComPortNum;π Intr($14,Reg);πEND;ππPROCEDURE SetDTR;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := 6;π Reg.DX := ComPortNum;π Reg.AL := Byte(A);π Intr($14,Reg);πEND;ππPROCEDURE FlushOutput;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := 8;π Reg.DX := ComPortNum;π Intr($14,Reg);πEND;ππPROCEDURE PurgeOutput;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := 9;π Reg.DX := ComPortNum;π Intr($14,Reg);πEND;ππPROCEDURE PurgeInput;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := $0A;π Reg.DX := ComPortNum;π Intr($14,Reg);πEND;ππFUNCTION CarrierDetect;πBEGINπ IF ComPortNum < 0 then CarrierDetect := true elseπ beginπ Reg.AH := 3;π Reg.DX := ComPortNum;π Intr($14,Reg);π CarrierDetect := (Reg.AL AND $80) > 0;π end;πEND;ππFUNCTION SerialInput;πBEGINπ IF ComPortNum < 0 then SerialInput := true elseπ beginπ Reg.AH := 3;π Reg.DX := ComPortNum;π Intr($14,Reg);π SerialInput := (Reg.AH And 1) > 0;π end;πEND;ππPROCEDURE WriteChar(c : char);πBEGINπ if ComPortNum < 0 then Display_Ansi(c) elseπ beginπ Reg.AH := $13;π Reg.AL := ORD(c);π Intr($14,Reg);π end;πEND;ππPROCEDURE FlowControl;πBEGINπ IF ComPortNum < 0 then exit;π Reg.AH := $0F;π Reg.DX := ComPortNum;π Reg.AL := A;π Intr($14, Reg);πEND;ππPROCEDURE WritePort(s : string);πVARπ i : byte;πbeginπ for i := 1 to length(s) doπ beginπ if (ComPortNum >= 0) then TransmitChar(s[i]);π DISPLAY_Ansi(s[i]);π if not CarrierDetect then halt(1);π end;πend;ππPROCEDURE WritelnPort(s : string);πBEGINπ s := s + #10 + #13;π WritePort(s);πend;ππFUNCTION ReadKeyPort : char;πvarπ ch : char;π count : longint;πbeginπ count := 0;π repeatπ if not carrierdetect then exit;π if ComPortNum < 0 then ch := readkey elseπ if KeyPressedPort then ch := ReceiveChar elseπ if keypressed then ch := readkey elseπ ch := #0;π if ch = #0 then inc(count);π until (ch > #0) or (count > timeout);π ReadKeyPort := ch;πend;ππPROCEDURE ReadPort(var C : char);πtypeπ C_Type = char;πvarπ CPtr : ^C_Type;π ch : char;π count : longint;πbeginπ CPtr := @C;π count := 0;π repeatπ if not carrierdetect then halt(1);π if ComPortNum < 0 then ch := readkey elseπ if KeyPressedPort then ch := ReceiveChar elseπ if keypressed then ch := readkey elseπ ch := #0;π if ch = #0 then inc(count) elseπ beginπ if (ComPortNum >= 0) then TransmitChar(ch);π DISPLAY_Ansi(ch);π end;π until (ch > #0) or (count > timeout);ππ CPtr^ := ch;πend;ππPROCEDURE ReadlnPort(var S : string);πtypeπ linestring = string;πvarπ SPtr : ^linestring;π st : string;π ch : char;πbeginπ SPtr := @S;π st := '';ππ repeatπ Ch := readkeyport;π if ch in [#32..#255] thenπ beginπ st := st + ch;π writeport(ch);π end elseπ if (ch = #8) and (st > '') thenπ beginπ delete(st,length(st),1);π writeport(#8+#32+#8);π end;π until ch in [#13,#0]; { will equal NULL if ReadPort timed out }π WritelnPort('');π SPtr^ := st;πend;ππPROCEDURE HangUp;πBEGINπ if ComPortNum < 0 then exit;π repeatπ SetDtr(TRUE); { lower DTR to hangup }π until Not CarrierDetect;π SetDtr(FALSE); { raise DTR again }πEND;ππBEGINπ Clrscr;π Write('SuperFos - by Wayne Boyd 1:153/763');π delay(1000);πEND.π 54 08-25-9409:06ALL ASGDC@ACVAX.INRE.ASU.EDU Sending Chars to the COM SWAG9408 ¼ç░╙ 77 ╣J {π> I have a Turbo Pascal "interrupt" routine which "catches" incomingπ> characters from a COM port and stashes them in a circular buffer.π> While it seems to work OK most of the time, occasionally it missesπ> a character (it can NOT keep up with 600 baud, but Kermit does quiteπ> well at 9600 baud, so I know it can be "fixed"). Here is the code:π> (Please ignore the BEGINPROCEDURE, ENDIF, etc.; I use a pre-processorπ> to translate Pascal-as-it-ought-to-be-IMHO into Turbo Pascal.)π>πI don't know what the trouble is with your interrupt routine, but I wrote oneπabout 6 months ago for a friend to use and it works fine on my machine (386π33) at 2400 and on my friends machine (486 66) at 9600. Here it is, hope itπhelps.ππThis unit is an array implementation of a queue, used to store incomingπcharacters. An array is used instead of a linked list because I believed itπwould be faster, and less overhead.π}πUNIT QPak;π{$R-}π{Range checking must be turned off, so as to permit the little trick withπthe array}ππINTERFACEππTYPEπ ElementType = Char;ππ ElementArray = ARRAY[0..0] OF Char;ππ QUEUE = RECORDπ Front,π Rear : Word;π EL : ^ElementArray;π Size : Word;π Count : Word;π END;ππPROCEDURE MakeQueueEmpty(VAR Q : Queue;π QSize : Word);ππFUNCTION QueueIsEmpty(Q : Queue) : Boolean;ππFUNCTION QueueIsFull(Q : Queue) : Boolean;ππPROCEDURE Enqueue(VAR Q : Queue;π Element : ElementType);ππPROCEDURE Dequeue(VAR Q : Queue;π VAR Element : ElementType);ππIMPLEMENTATIONπππPROCEDURE MakeQueueEmpty(VAR Q : Queue; QSize : Word);ππBEGINπ GetMem(Q.EL,QSize);π Q.Front := 1;π Q.Rear := 0;π Q.Size := QSize;π Q.Count := 0;πEND;ππFUNCTION QueueIsEmpty(Q : Queue) : Boolean;ππBEGINπ QueueIsEmpty := (Q.Count = 0);πEND;ππFUNCTION QueueIsFull(Q : Queue) : Boolean;ππBEGINπ QueueIsFull := (Q.Count = Q.Size);πEND;πππPROCEDURE Enqueue(VAR Q : Queue; Element : ElementType);ππBEGINπ WITH Q Do BEGINπ Rear := (Rear + 1) MOD Size;π EL^[Rear] := Element;π Inc(Count);π END;πEND;ππPROCEDURE Dequeue(VAR Q : Queue; VAR Element : ElementType);ππBEGINπ WITH Q DO BEGINπ Element := EL^[Front];π Front := (Front + 1) MOD Size;π Dec(Count);π END;πEND;ππEND.π{π-----------------------CUT HERE--------------------ππHere is the com unit. I've commented about everyline (since it was for aπfriend) so hopefilly my comments are understandable.ππ-----------------------CUT HERE---------------------π}πUNIT ComUnit;ππINTERFACEππUSES DOS, CRT, QPak;ππPROCEDURE InitPort(ComPort,π Parity,π Stop,π WLength : Byte;π Speed : Word);ππFUNCTION CharReady(ComPort : Byte) : Boolean;ππ{This procedure writes a char to desired port}πPROCEDURE SendChar(Ch : Char; ComPort : Byte);ππ{This function reads a char from the serial port by dequeueing and element}πFUNCTION GetChar(ComPort : Byte) : Char;ππPROCEDURE ShutDown(ComPort : Byte);ππTYPEπ UART = RECORDπ THR : Integer; {Transmit Holding Register}π RBR : Integer; {Receive Holding Register}π IER : Integer; {Interrupt enable Regeister}π LCR : Word; {Line Control Register}π MCR : Integer; {Modem Control Register}π LSR : Integer; {Line Status Register}π MSR : Integer; {Modem Status Register}π IRQ : Integer;π DLL : Word;π DLM : WOrd;π END;ππ {This array holds the buffers for each port}π BufferArray = ARRAY[1..4] OF Queue;π {Here is where we save the old interrupt vectors}π PointerArray = ARRAY[1..4] OF Pointer;πππCONSTπ{The following are constants used in initialization, and for port adressing}π COM1 = 1;π COM2 = 2;π COM3 = 3;π COM4 = 4;ππ{Baud rate divisors}π B600 = 192;π B1200 = 96;π B2400 = 48;π B4800 = 24;π B9600 = 12;π B19200 = 6;π B38400 = 3; {If your really feeling frisky}ππ{Parity masks}π NoParity = 0;π OddParity = $8;π EvenParity = $18;ππ{Stop bit masks}π OneStopBit = 0;π TwoStopBit = 2;ππ{OR-Mask to set divisor latch in line control register}π DLatch = $80;ππ{Port address for interrupt mask port of 8259A}π IntMaskPort = $21;ππ{Port address for 8259 interrupt control, used to send EOI}π IntCtlPort = $20;ππ{Masks for different word lengths}π Word5 = 0;π Word6 = 1;π Word7 = 2;π Word8 = 3;ππIMPLEMENTATIONππCONSTπ{Typed constant that contains all registers addresses for Com1..Com4}π RS232 : ARRAY[1..4] OF UART =ππ((THR:$3F8;RBR:$3F8;IER:$3F9;LCR:$3FB;MCR:$3FC;LSR:$3FD;MSR:$3FE;IRQ:4;DLL:$3F8π;πLM:$3F9),ππ(THR:$2F8;RBR:$2F8;IER:$2F9;LCR:$2FB;MCR:$2FC;LSR:$2FD;MSR:$2FE;IRQ:3;DLL:$2F8;πLM:$2F9),π π(THR:$3E8;RBR:$3E8;IER:$3E9;LCR:$3EB;MCR:$3EC;LSR:$3ED;MSR:$3EE;IRQ:4;DLL:$3E8;πLM:$3E9),π π(THR:$2E8;RBR:$2E8;IER:$2E9;LCR:$2EB;MCR:$2EC;LSR:$2ED;MSR:$2EE;IRQ:3;DLL:$2E8;πLM:$2E9));πππVARπ Buffers : BufferArray;π IntVecsSave : PointerArray;ππ{Inline Macros}πPROCEDURE DisableInterrupts ; inline( $FA {cli} ) ;πPROCEDURE EnableInterrupts ; inline( $FB {sti} ) ;ππ{Here is the interrupt procedure for com3, its address is put int the intπ Vec table by InitPort}πPROCEDURE Com13ISR; INTERRUPT;ππBEGINπ{Read the character from the port and put it in the queue}π Enqueue(Buffers[Com3],Char(Port[RS232[Com3].RBR]));π Port[IntCtlPort] := $20; {Non-specific EOI}πEND;ππPROCEDURE Com24ISR; INTERRUPT;ππBEGINπ{Read the character from the port and put it in the queue}π Enqueue(Buffers[Com3],Char(Port[RS232[Com3].RBR]));π Port[IntCtlPort] := $20; {Non-specific EOI}πEND;ππ{---------------------------------------------------------------}π{ +++InitPort+++ }π{ }π{ ComPort: A byte specifying the comport to use Range 1..4 }π{ Speed : This is really the baud rate divisor The predefined }π{ constants are the correct divisors for those speeds }π{ Parity, }π{ Stop, }π{ WLength: These are all bit-masks used to build }π{ the line format byte }π{---------------------------------------------------------------}πPROCEDURE InitPort(ComPort,π Parity,π Stop,π WLength : Byte;π Speed : Word);ππVARπ LineFormat : Byte;πππBEGINπ MakeQueueEmpty(Buffers[ComPort],2048);π LineFormat := 0;π{Build the line format byte}π LineFormat := LineFormat OR WLength OR Stop OR Parity;π{Set divisor latch so we can set baud rate}π Port[RS232[ComPort].LCR] := LineFormat AND DLatch;π{Now we set baud rate, least sig part of divisor sent first then most sig}π Port[RS232[ComPort].DLL] := Low(Speed);π Port[RS232[ComPort].DLM] := Hi(Speed);π{Now set line format}π Port[RS232[ComPort].LCR] := LineFormat;π{Must set out2 of modem control reg for interrupts, so we do it here}π Port[RS232[ComPort].MCR] := $0B;π{Save interrupt vector so we can restore it later, then set vector toπ point at our ISR}ππ{Now we must unmask appropriate int line in 8259A interrupt controllerπ We are using IRQ4 for com1 and 3, and IRQ3 for com2 and 4, use of anyπ other IRQ line will require changes to the code}π IF ODD(ComPort) THEN BEGINπ GetIntVec(RS232[ComPort].IRQ+8,IntVecsSave[ComPort]);π SetIntVec(RS232[ComPort].IRQ+8,@Com13ISR);π Port[IntMaskPort] := Port[IntMaskPort] AND $EFπ END ELSE BEGINπ GetIntVec(RS232[ComPort].IRQ+8,IntVecsSave[ComPort]);π SetIntVec(RS232[ComPort].IRQ+8,@Com24ISR);π Port[IntMaskPort] := Port[IntMaskPort] AND $F7;π END;π{Here we tell 8250 UART to interrupt on received chars}π DisableInterrupts;π Port[Rs232[ComPort].IER] := 1;π EnableInterrupts;ππEND;ππ{This function returns true if there are any chars in the buffer}πFUNCTION CharReady(ComPort : Byte) : Boolean;ππBEGINπ CharReady := NOT QueueIsEmpty(Buffers[ComPort]);πEND;ππ{This procedure writes a char to desired port}πPROCEDURE SendChar(Ch : Char; ComPort : Byte);ππBEGINπ {Loop until transmit holding register empty}π WHILE (Port[RS232[ComPort].LSR] AND $20) <> $20 DOπ Delay(1);π Port[RS232[ComPort].THR] := Byte(Ch);πEND;ππ{This function reads a char from the serial port by dequeueing and element}πFUNCTION GetChar(ComPort : Byte) : Char;ππVARπ Ch : Char;ππBEGINπ Dequeue(Buffers[ComPort],Ch);π GetChar := Ch;πEND;πππPROCEDURE ShutDown(ComPort : Byte);ππBEGINπ SetIntVec(RS232[ComPort].IRQ+8,IntVecsSave[ComPort]);πEND;ππEND.ππ{π------------------CUT HERE---------------------ππOne remark is probably appropriate here. My friend had the need to read twoπports simultaneously so that is why there are two interrupt rountine, one comπ1 and 3 and one for com 2 and 4, since they use the same IRQ lines.ππHere is a little test program I used.ππ-----------------CUT HERE----------------------π}πUSES CRT, ComUnit;πVARπ Ch : Char;π Done : Boolean;ππBEGINπ Done := FALSE;π InitPort(Com3,NoParity,OneStopBit,Word8,B2400);π ClrScr;π Writeln('Com test in progress. F1 to exit');π REPEATπ IF CharReady(Com3) THEN BEGINπ Ch := GetChar(Com3);π Write(Ch);π ENDπ ELSE IF Keypressed THEN BEGINπ Ch := ReadKey;π IF CH = #0 THEN BEGIN {Extended key scan code}π Ch := Readkey;π IF Ch = #59 THEN {F1}π Done := True;π END ELSEπ SendChar(Ch,Com3);π ENDπ UNTIL Done;π ShutDown(Com3);πEND.π{ππI hope this helps. It does work, although there could some thing wrong givenπI'm no expert. I also wrote some routines in assember about a year and aπhalf ago, so if you really want assembly code I'd be happy to did them out.π}ππ 55 08-25-9409:07ALL GREG VIGNEAULT RS-232 to serial port SWAG9408 yZ¡ 29 ╣J {πGV>If it's high you may not be able to rely upon TP's Read/Writeπ >procedures. If it's really high you may need to let an ISR doπ >the job of i/o buffering.πJS> Oh! God. I hope not. I'm not ready for TSRs. Oops, you didn'tπ > say TSR, you said ISR.ππ Have no fear... I wouldn't lead you into waters that you couldn'tπ navigate through on your own! But, how about getting familiarπ with using the CPU Registers, and the BIOS, via TP? [FYI: ISRsπ (interrupt service routines) can be run attached to the DOS, inπ the form of TSRs or device drivers, or temporarily as part of anπ application.]ππ 9600 bits-per-second (bps) is about as fast as vanilla DOS canπ go with the serial ports. To be safe from loosing data, yourπ i/o should be buffered by a hardware-driven ISR. But, as you say,π writing & interfacing to a TSR/ISR can be a bit heady, especiallyπ when all you need is the odd text string.ππ I'd recommend that you use a "FOSSIL driver," such as X00. Itπ gets loaded as a TSR in your AUTOEXEC.BAT file, or as a deviceπ driver in CONFIG.SYS, and intercepts the BIOS serial interruptπ to provide data capture & buffering. X00 is solid, and is used byπ many BBS SysOps. It's available for download at most local BBSs.π It can be run under DOS, Windows, or DESQview.ππ You can use TP's INTR() function to talk with the serial port, orπ use one of the existing TP source code libraries that can also beπ found on BBSs. The X00 archive comes with an example of using X00π with TP, and even has a ready-to-link TPX00.OBJ file.ππ The X00 commands are a superset of BIOS interrupt 14H commands, soπ you may already have a book which documents how to use it -- thoughπ you'll probably want to know how to set the buffer size, etc. X00π comes with thorough documentation.ππJS> Although it is 9600 baud, a data string is sent only every secondπ > or longer. One data string BTW consists of a concentration and aπ > date/time in a format something like this:π > 350.0ppm 12:42:37 Jun 13'94π > so you can see that the port is idle most of the time. I knowπ > that might not matter.ππ This should be easy enough to handle. Here's an example snippet ofπ using X00 with TP (from the X00 archive file) ...π}ππ CONST Buffer_Size = 1024;ππ VAR Regs : REGISTERS;π Input_Buffer : ARRAY [1..Buffer_Size] OF BYTE;ππ PROCEDURE Bypass; EXTERNAL;π PROCEDURE TPX00( VAR Regs : REGISTERS ); EXTERNAL; {$L TPX00}ππ BEGINπ { Check for active FOSSIL }π Regs.AH := $04; Regs.BX := 0; Regs.DX := $00FF;π { INTR( $14, Regs ); is replaced with }π TPX00( Regs );π FOSSIL_Active := Regs.AX = $1954;ππ IF FOSSIL_Active THEN BEGINπ { Open FOSSIL port 0, COM1 }π Regs.AH := $04; Regs.BX := 0; Regs.DX := $0000;π { INTR( $14, Regs ); is replaced with }π TPX00( Regs );π { Do a block read from the FOSSIL input buffer for COM1 }π Regs.AH := $18; { Block read func code }π Regs.DI := OFS( Input_Buffer ); { Input buffer offset to DI }π Regs.ES := SEG( Input_Buffer ); { Input buffer segment to ES }π Regs.CX := Buffer_Size; { Max bytes to read to CX }π Regs.DX := 0; { Data from COM1 }π { INTR( $14, Regs ); is replaced with }π TPX00( Regs );π { Upon return, Regs.AX will contain the number of bytes that X00 }π { placed into Input_Buffer. }π END;π{π If this looks too "scary," you could try one of the existing TPπ FOSSIL interface libraries, which would provide a higher-level ofπ functions (eg. GetComChar, etc).π}π 56 08-25-9409:08ALL GERHARD HOOGTERP Fossil Interrupt SWAG9408 Ö~ 16 ╣J {πFrom: gerhard@loipon.wlink.nl (Gerhard Hoogterp)ππ> > Anyhow, the point is usualy not which fossil is loaded butπ> > if there is a fossil at all. And that's what the $1954 result is for.ππ>I now realize that $1954 will be returned for either BNU/X00, but I wouldπ>still like to be able to list to screen "which" fossil has been detected,π>and I cannot seem to figure it out.ππ}πUses Dos;ππConst UsePort = 0;ππType InfoArray = Array[0..255] of Char;π FossilInfo = Recordπ Size : Word; { Record Size }π MajVer : Byte; { Major Version }π MinVer : Byte; { Minor Version }π IndentPtr : ^InfoArray; { Indentifier }π InpSize : Word; { Size inp. Buffer }π InpFree : Word; { Free in inp. buffer }π OutBuf : Word; { Size out. Buffer }π OutFree : Word; { Free in out. Buffer }π SWidth : Byte; { Screen width }π SHeight : Byte; { Screen height }π End;ππVar Info : FossilInfo;π C : Byte;ππProcedure InitPort(Port : Word);πVar Regs : Registers;πBeginπWith Regs Doπ Beginπ AH:=$04;π DX := Port;π Intr($14,Regs);π If AX<>$1954π Then Halt;π End;πEnd;πππProcedure GrabPortInfo(Port : Word);πVar Regs : Registers;πBeginπWith Regs Doπ Beginπ AH:=$1B;π DX:=Port;π CX:=SizeOf(Info);π ES:=Seg(Info);π DI:=Ofs(Info);π Intr($14,Regs);π End;πEnd;πππProcedure DonePort(Port : Word);πVar Regs : Registers;πBeginπWith Regs Doπ Beginπ AH:=$05;π DX:=Port;π Intr($14,Regs);π End;πEnd;πππBeginπFillChar(Info,SizeOf(Info),#00);ππInitPort(UsePort);πGrabPortInfo(UsePort);ππWriteLn('Fossil ID:');πWrite(' ');ππC:=0;πWhile (C<256) And (Info.IndentPtr^[C]<>#00) Doπ Beginπ Write(Info.IndentPtr^[C]);π Inc(C);π End;πWriteln;ππDonePort(UsePort);πEnd.ππ 57 08-25-9409:08ALL PATRICK BERNIER Fossil Identification SWAG9408 ╩0hƒ 18 ╣J {πFrom: Patrick.Bernier@f209.n167.z1.fidonet.orgππ>I now realize that $1954 will be returned for either BNU/X00, but I wouldπ>still like to be able to list to screen "which" fossil has been detected,π>and I cannot seem to figure it out.ππ > try to call to the fossile with ah=1bh and you'll getπ > an info record,π > containing pointer for fossil ID string ..ππTrue. Here is an excerpt from 'myfos', my fossil interface unit; F_GetDrvID()πwill return a string containing the current fossil driver's identification.πSorry for the sloppy coding, I programmed this thing quite a while ago andπsince it worked I never updated it to my current programming skills...ππ<incomplete code - won't compile>π}π typeπ F_IdentPtr = ^F_IdentStr;π F_IdentStr = array[1..255] of byte;π F_InfoBlock = record { len = 69 }π size: word; { Size of the infoblock }π majver: byte; { Version (high byte) }π minver: byte; { ... (low byte) }π ident: F_identptr; { Pointer to asciiz ID of driver }π ibufr: word; { Input buffer size }π ifree: word; { Input buffer free }π obufr: word; { Output buffer size }π ofree: word; { Output buffer free }π swidth: byte; { Width of screen (in chars) }π sheight: byte; { Height of screen }π baud: byte; { Actual baud rate (computer-modem)π}π end;ππ procedure F_GetDrvInfo;π beginπ regs.ah := $1b;π regs.cx := sizeof(F_InfoBlock);π regs.dx := F_PORT;π regs.es := Seg(F_Info);π regs.di := Ofs(F_Info);π intr($14,regs);π end;ππ function F_GetDrvID: string;π varπ InfoRec: F_IdentStr;π X: integer;π s: string;π beginπ F_GetDrvInfo;π InfoRec := F_Info.ident^;π X := 1;π s := '';π while InfoRec[X] <> 0 do beginπ s := s + chr(InfoRec[X]);π inc(X);π end;π F_GetDrvID := s;π end;ππ 58 08-25-9409:08ALL ANGUS C. MARCH Mail Manager SWAG9408 ∙┐` 128 ╣J {πFrom: ac_march@ECE.Concordia.CA (Angus C. March)ππI have this grave problem where when I use this certain program that calls aπfunction that I defined in a unit, the program shortly hangs up. Oddly enoughπif I start peppering the regions of code about where the hang up occurs it isπdelayed. As another interesting piece of information: pushing ctrl-breakπcauses the hangup as well.π Anyway, the following is a Turbo Pascal 6.0 partially written inπBorland. It's REAL LONG, so I'm not going to expect anyone to sift throughπall the code, that is why I have COMMENTED THE KEY POINTS IN CODE w/UPPERCASEπLETTERS, so it will be MUCH EASER TO FIND. Just like a comic book advert forπa martial arts course.ππ Anyway, here is all the code.π}ππProgram mailManager;ππUses DOS, CRT, AngusU; {AngusU= A UNIT WITH MY OWN ROUTINES, SEE END IFπ POST}ππConstπ background = Blue;π foreground = LightGray;ππ scrX = 80;π scrY = 25;π scrXY = 80*25;πππType {screen save types}π scrXRange = 1..scrX; {x-axis range of my screen}π scrYRange = 1..scrY; {y- " " " " "}π scrXYRange = 1..scrXY;π scrElementRecord = Record {attributes of a cell on the text screen}π element: Char;π colour: Byte;π end;π scrPointer = ^scrNode;π scrNode = Record {linked list of window to be put on the stack}π cell: scrElementRecord;π next: scrPointer;π end;π scrStackPointer = ^stackNode; {These set the stack}π stackNode = Recordπ scrWindowPointer: scrPointer; {pointer to window to be saved}π cursorX, {where cursor was left}π left, right: scrXRange; {boundries of the window to be saved}π cursorY, {where cursor was left}π top, bottom: scrYRange; {boundries of the window to be save}π winMax, winMin: Word; {boundries of the window}π colour: Byte; {textAttr}π downward: scrStackPointer; {pointer to next place in stack}π end;ππ {menuTypes}π stringPointer = ^stringNode;π stringNode = Recordπ prev,next: stringPointer; {strings passed to menu}π streng: String;π end;πππVarπ dummy, menuAnswer: Char;π p: DirPointer;π head, bufferPointer, q: stringPointer;π menuCand: String;π COUNTER: Byte;π EXTENDED: BOOLEAN;ππ {screen save vars}π scrStack: scrStackPointer;πππ{Procedure colorWindow;πVarπ i: Word;ππBeginπ TextBackground(White);π For i:= 1 To 2000 Doπ Write(' ');πend;}πππFunction strg(x: Longint): String;πVarπ carry: String;ππBeginπ Str(x, carry);π strg:= carry;πend;πππProcedure message(messg: String);πVarπ carryWindMax, carryWindMin: Word;π carryWhereX: scrXRange;π carryWhereY: scrYRange;ππBeginπ carryWhereX:= WhereX; carryWhereY:= WhereY;π carryWindMax:= WindMax; carryWindMin:= WindMin;π Window(1, 25, 80, 25);π Write(messg);π WindMax:= carryWindMax; WindMin:= carryWindMin;π GotoXY(carryWhereX, carryWhereY);πend;πππProcedure shiftWindow(xShift, yShift: Shortint);πBeginπ Window(Lo(WindMin) + 1 + xShift, Hi(WindMin) + 1 + yShift, Lo(WindMax) +π1 + xShift, Hi(WindMax) + 1 + yShift);πend;πππProcedure getCursorChar(Var attrib, charCode: Byte);π{THIS THING DOESN'T WORK VERY WELL BUT IT ISN'T CAUSING THE PROBLEMπBECAUSE THE PROBLEM REMAINS WHEN THIS PROCEDURE IS REMOVED FROM THE CODE}πVarπ reg: Registers;{regPack}ππBeginπ Reg.AH := 8; {Function 8 = Read attribute and character at cursor.}π Reg.BH := 0; {Use display page = 0}ππ Intr(10,Reg); {Call Interrupt 10 (BIOS)}ππ attrib := Reg.AH; {Get atrribute value from result.}π charCode:= Reg.AL; {Get character code from result.}πend;πππProcedure getChar(x: scrXRange; y: scrYRange; Var cell: scrElementRecord);πVarπ xCarry: scrXRange;π yCarry: scrYRange;π colour, charOrd: Byte;ππBeginπ xCarry:= WhereX; yCarry:= WhereY;π GotoXY(x, y);π getCursorChar(colour, charOrd);π cell.colour:= colour;π cell.element:= Chr(charOrd);πdummy:= WriteRead(''); {THIS IS INSTRUMENTAL IN THE PROBLEM! IF I TAKE THISπOUT THE PROBLEM GOES AWAY... FOR A WHILE. SEE THE END OF THE PROGRAM FORπTHE IMPLEMENTATION OF THE ANGUSU UNIT}π GotoXY(xCarry, yCarry);πend;πππFunction oneString(counter: Byte): String;πVarπ i: Byte;π beg, j: Word;π theString, letters: String;ππBeginπ j:= 1;π letters:= '';π theString:= 'Hi I''m Wayne Gretzky I scored 92 goals 10 years ago andπanyone who sez n that I''m a homosexual can go';π{ theString:= ConCat(theString, ' get run over by a starship. Max, you slyπpuss. Good grief this could take for Moncton');}π{ theString:= ConCat(theString, ' ever I mean all the things that we haveπto write');}π For i:= 1 To counter Doπ Beginπ beg:= j;π While Not(thestring[j] = ' ') And (j < Length(theString)) Doπ j:= j + 1;π j:= j + 1;π end;π If j > Length(theString) Thenπ letters:= ''π Elseπ For i:= beg To j - 1 Doπ letters:= Concat(letters,theString[i]);π oneString:= letters;πend;πππ{Procedure scrSaveParam;}πππProcedure initStack;πBeginπ scrStack:= Nil;πend;πππProcedure scrPush(scr: scrPointer; left, right: scrXRange;π top, bottom: scrYRange);πVarπ carryStackPointer: scrStackPointer;π carryWindMax, carryWindMin: Word;ππBeginπ carryWindMax:= WindMax; carryWindMin:= WindMin;ππ Window(1, 1, 80, 25);π carryStackPointer:= scrStack;π New(scrStack);π scrStack^.cursorX:= WhereX; scrStack^.cursorY:= WhereY;π scrStack^.winMax:= carryWindMax; scrStack^.winMin:= carryWindMin;π scrStack^.colour:= TextAttr;π scrStack^.scrWindowPointer:= scr;π scrStack^.left:= left; scrStack^.right:= right; scrStack^.top:= top;πscrStack^.bottom:= bottom;π scrStack^.downward:= carryStackPointer;π WindMax:= carryWindMax; WindMin:= carryWindMin;πend;πππProcedure scrPop(Var scr: scrPointer; Var left, right: scrXRange;π Var top, bottom: scrYRange);πVarπ carry: scrStackPointer;ππBeginπ Window(1, 1, 80, 25);π GotoXY(scrStack^.cursorX, scrStack^.cursorY);π WindMax:= scrStack^.winMax; WindMin:= scrStack^.winMin;π TextAttr:= scrStack^.colour;π scr:= scrStack^.scrWindowPointer;π left:= scrStack^.left; right:= scrStack^.right; top:= scrStack^.top;πbottom:= scrStack^.bottom;π carry:= scrStack;π scrStack:= scrStack^.downward;π Dispose(carry);πend;πππProcedure initWindowPointer(Var pointer: scrPointer);πBeginπ pointer:= Nil;πend;πππProcedure scrStoreElement(Var pointer: scrPointer; Var cell: scrElementRecord);πVarπ buffer: scrPointer;π messg: Char;ππBeginπ New(buffer);π buffer^.cell:= cell;π{messg:= buffer^.cell.element;πmessage(messg);πWrite('We are now saving ',Ord(messg));}π buffer^.next:= Nil;π If pointer = Nil Thenπ pointer:= bufferπ Elseπ pointer^.next:= buffer;πend;ππProcedure scrRetrieveElement(Var pointer: scrPointer; Var charChar: Char);πVarπ carry: scrPointer;ππBeginπ If pointer= Nil Thenπ WriteLn('hey this is Nil!')π Elseπ Beginπ charChar:= pointer^.cell.element;π TextAttr:= pointer^.cell.colour;π carry:= pointer;π pointer:= pointer^.next;π Dispose(carry);π end;πend;πππProcedure windowSave;πVarπ x: scrXRange;π y: scrYRange;π windowPointer: scrPointer;π cell: scrElementRecord;ππBeginπ initWindowPointer(windowPointer);π For y:= Hi(WindMin) + 1 To Hi(WindMax) + 1 Doπ For x:= Lo(WindMin) + 1 To Lo(WindMax) + 1 Doπ Beginπ getChar(x, y, cell);π WriteLn('Ok, I get here',x,' ',y,' ',cell.colour,'π',Ord(cell.element));π scrStoreElement(windowPointer, cell);π end;π scrPush(windowPointer, Lo(WindMin) + 1, Lo(WindMax) + 1, Hi(WindMin) + 1,πHi(WindMax) + 1);πend;πππProcedure windowRetrieve;πVarπ x, left, right: scrXRange;π y, top, bottom: scrYRange;π windowPointer: scrPointer;π element: Char;ππBeginπ scrPop(windowPointer, left, right, top, bottom);π scrPush(windowPointer, 1, 1, 1, 1);π Window(1, 1, 80, 25);π For y:= top To bottom Doπ For x:= left To right Doπ Beginπ GotoXY(x, y);πIf Not(windowPointer = Nil) Thenπ scrRetrieveElement(windowPointer, element);π Write(element);π end;π scrPop(windowPointer, left, right, top, bottom);πend;πππProcedure drawMenu(head: stringPointer; Var extended: Boolean);π{THIS PROCEDURE IS PASSED A SET OF STRINGS, LINKED-LISTED, AND MAKE A MENUπOF THEM}πVarπ size, longest: Word;ππ bufferPointer: stringPointer;π menuWidth, x, middleX: scrXRange;π menuHeight, y,middleY: scrYRange;ππBeginππ bufferPointer:= head;π size:= 0; longest:= 0;ππ While Not(bufferPointer = Nil) Doπ Beginπ size:= size + 1;π If (Length(bufferPointer^.streng) > longest) Then longest:=πLength(bufferPointer^.streng);π bufferPointer:= bufferPointer^.next;π end;π extended:= ((size + 1) Div 2) > (Hi(WindMax) - Hi(WindMin) - 3);ππ middleX:= (Lo(WindMax) - Lo(WindMin) + 1) Div 2;π middleY:= (Hi(WindMax) - Hi(WindMin) + 1) Div 2;π If extended Thenπ Window(middleX - (longest + 1), Hi(WindMin) + 1, middleX + longest + 2,π Hi(WindMax) + 1)π Elseπ Window(middleX - (longest + 1), (middleY - 1) - (size - 1) Div 4,π middleX + longest + 2, (middleY + 1) + (size + 1) Divπ4);π shiftWindow(-25, -4);π windowSave;π menuWidth:= Lo(WindMax) - Lo(WindMin) - 1;π menuHeight:= Hi(WindMax) - Hi(WindMin) + 1;π If extended Then menuHeight:= menuHeight - 1;π middleX:= (Lo(WindMax) - Lo(WindMin)) Div 2;π middleY:= (Hi(WindMax) - Hi(WindMin) + 1) Div 2;π GotoXY(1, 1);π TextColor(White); Write('╔'); For x:= 1 To menuWidth - 2 Do Write('═');πWriteLn('╗');π For y:= 2 To menuHeight - 1 Doπ Beginπ TextColor(White); Write('║'); TextColor(Yellow);π Write(head^.streng);π clrEol;π If Not(head^.next = Nil) Thenπ Beginπ GotoXY(middleX + 2, y);π Write(head^.next^.streng);π end;π head:= head^.next^.next;π GotoXY(menuWidth, y);π TextColor(White); WriteLn('║'); TextColor(Yellow);π end;π TextColor(White);π If extended Thenπ Beginπ Write('║');π GotoXY(middleX - 8, WhereY);π Write('Page Up/Page Down');π GotoXY(menuWidth, WhereY);π WriteLn('║');ππ end;π Write('╚'); For x:= 1 To menuWidth - 2 Do Write('═'); Write('╝');πend;πππProcedure writeLnHighLight(streng: String; foreground, background: Byte);πVarπ i: Shortint;π textStart: Byte;ππBeginπ textStart:= TextAttr;π TextBackground(background);π TextColor(foreground);π For i:= 1 To Length(streng) Doπ Beginπ If streng[i] = '(' Thenπ TextColor(White)π Elseπ If streng[i] = ')' Thenπ TextColor(foreground)π Elseπ Write(streng[i]);π end;π WriteLn;π TextAttr:= textStart;πend;πππBeginπ COUNTER:= 1;π menuAnswer:= ' ';π TextBackground(background);π TextColor(foreground);π ClrScr;ππ writeLnHighLight(' Mailing (L)ist (C)onfigure Schedual π (M)ail E(x)it',π LightBlue, LightGray);π Window(1, 2, 80, 25);ππ menuCand:= 'Wayne Gretzky';π WriteLn('Ok tell Santa what you want to put in the menu');π New(bufferPointer);π head:= bufferPointer;π q:= Nil;π While Not(menuCand = '') Doπ Beginπ menuCand:= oneString(COUNTER);π COUNTER:= COUNTER + 1;π If Not(menuCand = '') Thenπ Beginπ q^.next:= bufferPointer; bufferPointer^.prev:= q;πbufferPointer^.next:= Nil;π bufferPointer^.streng:= menuCand;π q:= bufferPointer;π New(bufferPointer);π end;π end;π{THIS PART OF THE PROGRAM IS JUST TRYING TO DRAW A MENU AND SEE IF IT CAN BEπREAD OFF THE SCREEN. SO FAR I HAVEN'T HAD MUCH LUCK.}π drawMenu(head, extended);π dummy:= WriteRead('Just lemme know when you''re tired of looking at itπ(Anykey)');π windowRetrieve;π While Not(menuAnswer = 'X') Doπ Beginπ menuAnswer:= WriteRead('');π end;πend.ππππUnit AngusU;ππInterfaceπ Uses DOS, CRT;ππ Typeπ RealDecimalRange = 0..38;ππ DirPointer = ^listpointer;π listpointer = Recordπ results: SearchRec;π next: DirPointer;π end;ππ Function WriteRead(message: String): Char;π {Outputs messages, and waits for a single key input}ππ Function WriteReadLn(message: String): String;π {Outputs message, and waits for entered keyboard input}ππ Procedure Dir(pathway: PathStr; Var list: DirPointer);π {Do the Gilligan's directory thing, and return attributes in linkedπlist}ππ Function AllUpCase(streng: String): String;ππ Function Log(argu: Real): Real;π {Returns common logrithm}ππ Function DeScience(input: Real; decimal: RealDecimalRange): String;π {Reads a real number and outputs it in string}πππImplementationπ Function WriteRead(message: string): Char;π{SO FAR, OTHER THAN ONE OF THE TYPES THIS IS THE ONLY THING FROM THIS UNITπTHAT I INVOKE. AGAIN, IF I REMOVE THE CODE FROM MY CALLER PROGRAM (I FORGET THEπPROGRAMMER JARGON FOR IT) THE PROBLEM SEEM TO DECREASE}.π {Outputs messages, and waits for a single key input}π Beginπ Write(message);π WriteRead:= UpCase(ReadKey);π end;πππ Function WriteReadLn(message: String): String;π {Outputs message, and waits for entered keyboard input}π Varπ buffer: String;ππ Beginπ Write(message);π ReadLn(buffer);π WriteReadLn:= buffer;π end;πππ Procedure Dir(pathway: PathStr; Var list: DirPointer);π {Do the Gilligan's directory thing, and return attributes inπlinked list}π Varπ carry, buffer: DirPointer;π searchBuff: SearchRec;π i, j: Integer;ππ Beginπ New(list);π FindFirst(pathway, AnyFile, searchBuff);π If DosError = 0 Thenπ list^.results:= searchBuff;ππ New(buffer);π list^.next:= buffer;π carry:= list;π While DosError = 0 Doπ Beginπ FindNext(searchBuff);π buffer^.results:= searchBuff;π If DosError = 0 Thenπ Beginπ carry:= buffer;π New(buffer);π carry^.next:= buffer;π end;π end;π carry^.next:= Nil;π end;πππ Function AllUpCase(streng: String): String;π Varπ i: Integer;ππ Beginπ For i:= 1 To Length(streng) Doπ streng[i]:= UpCase(streng[i]);π AllUpCase:= strengπ end;πππ Function Log(argu: Real): Real;π Beginπ Log:= Ln(argu)/Ln(10);π end;πππ Function DeScience(input: Real; decimal: realDecimalRange):πString;π {Reads a real number and outputs it in string}π Varπ buffer: String;π Beginπ Str(input: trunc(Log(input) + 1): decimal, buffer);π DeScience:= buffer;π end;πend.π 59 08-25-9409:09ALL GREG VIGNEAULT Example Intr($14 SWAG9408 Γc╧ 24 ╣J {π>Hi Greg; I tried this out a few minutes ago but it insists onπ>accessing COM1.ππ Sorry about that. I should have used a single global CONSTant forπ the COM port number. I made the change, so now you just need toπ have "COMx = 2" for COM2.ππ This code is a quick'n-dirty example, so I'm certain that thereπ are errors/bugs in the COM i/o error checking. I'll take anotherπ look at it later...π}ππPROGRAM UseInt14;πUSES Dos, Crt;ππCONST COMx = 1; { <<-- 1 for COM1, 2 for COM2, etc. }ππVAR reg : Registers; { CPU registers }π Okay : BOOLEAN;π ch : CHAR; { i/o character }ππPROCEDURE InitCOM (PortNo,Baud,WordLen,Parity,Stops:WORD);π VAR IniParm:BYTE; BEGINπ IniParm := 0;π CASE Baud OFπ 300 : IniParm := 64;π 1200 : IniParm := 128;π 2400 : IniParm := 160;π 4800 : IniParm := 192;π 9600 : IniParm := 224;π END{CASE};π CASE Parity OFπ 1 : {odd} IniParm := IniParm OR 8;π 2 : {none} ;π 3 : {even} IniParm := IniParm OR 24;π END{CASE};π CASE Stops OFπ 2 : IniParm := IniParm OR 4;π ELSE ;π END{CASE};π CASE WordLen OFπ 7 : IniParm := IniParm OR 2;π 8 : IniParm := IniParm OR 3;π END{CASE};π reg.DX := PortNo - 1;; reg.AL := IniParm;;π reg.AH := 0;; Intr($14,reg);π END {InitCOM};ππPROCEDURE PutComChar (PortNo:WORD; Data:CHAR); BEGINπ reg.DX := PortNo - 1;; reg.AL := ORD(Data);;π reg.AH := 1;; Intr($14,reg);π Okay := ((reg.AL AND 14) = 0) OR NOT BOOLEAN(reg.AH SHR 7);π END {PutComChar};ππPROCEDURE GetComChar (PortNo:WORD; VAR Data:CHAR); BEGINπ reg.DX := PortNo - 1;; reg.AH := 2;; Intr($14,reg);;π Data := CHR(reg.AL);π Okay := ((reg.AL AND 14) = 0) OR NOT BOOLEAN(reg.AH SHR 7);π END {GetComChar};ππFUNCTION ComReady (PortNo:WORD):BOOLEAN; BEGINπ reg.AH := 3;; reg.DX := PortNo - 1;; Intr($14,reg);π Okay := ((reg.AL AND 14) = 0) OR NOT BOOLEAN(reg.AH SHR 7);π ComReady := (reg.AH AND 96) <> 0;π END {ComReady};ππFUNCTION ComDataAvailable (PortNo:WORD):BOOLEAN; BEGINπ reg.AH := 3;; reg.DX := PortNo - 1;; Intr($14,reg);π Okay := ((reg.AL AND 14) = 0) OR NOT BOOLEAN(reg.AH SHR 7);π ComDataAvailable := (reg.AH AND 1) <> 0;π END {ComDataAvailable};ππBEGIN {UseInt14}π InitCOM (COMx,9600,8,2,1); { initialize COMx: 9600 bps, 8n1 }π REPEATπ IF ComDataAvailable(COMx) THEN GetComChar(COMx,ch) ELSE ch := #0;π IF (ch <> #0) THEN Write (ch);π IF NOT Okay THEN WriteLn(#13,#10,'****COM I/O ERROR****',#7);π IF KeyPressed THEN ch := ReadKey ELSE ch := #0;π IF (ch <> #0) THEN BEGINπ REPEAT {wait} UNTIL ComReady(COMx);π PutComChar(COMx,ch);π END{IF};π IF NOT Okay THEN WriteLn(#13,#10,'****COM I/O ERROR****',#7);π UNTIL ch = #27; { exit when ESC key pressed }ππEND {UseInt14}.π 60 08-25-9409:12ALL THOMAS SKOGESTAD TELIX Phone File SWAG9408 ô;lÜ 36 ╣J {π│ Post more code so we can see where you're going wrong.ππI'm just posting things that are relevant, i.e. no error trapping codeπand such. Also I've deleted the original comments, as they are inπNorwegian, and added some new in English.ππAlso, I use one heck of a stack. The program worked fine on my machine,πI took it a friend and on his machine the default stack was too little.πWhen I came back the exact same program that I had been using on myπmachine also started complaining about the stack size. Could pointersπhelp in reducing stack?ππThis is the array I use to read BBS entries into from the text fileπ}π TBbsList = Recordπ BBSName : Array25; {All ArrayXX are defined as Array[1..XX] of Char}π BBSPhone : Array17;π end;ππTBBSArray = Array [1..1000] of TBBSList;πππProcedure Write2Fon(bbsnumber : Integer);ππ{This is the definition for the Telix .fon file format}πTYPEππ tddf_header = recordπ id : LongInt; (* should be hex 2e2b291a *)π ddf_vers : Integer; (* currently 1 *)π num_entries : Integer; (* # of entries in directory, from 1 to 1000 *)π pencrypted : Char; (* currently 0, will be used for encryption *)π spare : Array55;π end;ππ tdd_entry = recordπ name : Array25; (* entry name *)π number : Array17; (* phone number *)π baud : Byte; (* baud rate, see below *)π parity : Byte; (* parity: 0 = none, 1 = even, 2 = odd *)π data : Byte; (* number of data bits, 7 or 8 *)π stop : Byte; (* number of stop bits, 1 or 2 *)π script : Array12; (* linked script file name *)π lastcall : Array6; (* last call date, stored in ASCII, w/o slashes *)π totcalls : Word; (* total successful calls to this entry *)π terminal : Byte; (* terminal type to use, see below *)π protocol : Char; (* default protocol; first letter *)π toggles : Byte; (* bit 0: local echo - 0=off, 1=on *)π (* bit 1: add LFs - 0=off, 1=on *)π (* bit 2: BS trans - 0=destructive, 1=not *)π (* bit 3: BS key - 0=sends BS, 1=sends DEL *)π filler1 : Char;π filler2 : Char;π dprefnum : Byte; (* dialing prefix number to use when dialing *)π password : Array14; (* password for this entry *)π end;ππVARπ FonFile : File;π BBSCount : Integer;π SPcount : Byte;π SpareArr : Array55;π DDF_Header: Tddf_Header;π DD_Entry : Array[1..500] of Tdd_Entry;π tname : array25;π tnumber : array17;π tscript : array12;π tlastcall : array6;π tpassword : array14;π bname, bnumber, bscript, blastcall, bpassword : String;πππBEGINππAssign(FonFile, 'c:\modem\telix\test.fon'); {Yes it's hard coded right now}πReWrite(FonFile, 1);ππSPcount := 1;πWhile SPcount < 56 doπ Beginπ SpareArr[SPcount] := #0;π Inc(SPCount);π end;πππWith DDF_Header DO Beginπ ID := $2e2b291a;π DDF_Vers := 1;π Num_Entries := BBSNumber;π Pencrypted := '0';π Spare := SpareArr;πend;πππbscript := 'xxxxxx'; {Just some hard coding to get things to work}πblastcall := ' ';πbpassword := 'xxxxxx';πππString2Arr12(bscript, tscript); {I call a simple procedure to convert}π {from string to array of char}ππString2Arr6(blastcall, tlastcall);πString2Arr14(bpassword, tpassword);ππFor BBSCount := 1 to BBSNumber doπ Beginπ With DD_entry[BBSCount] DOπ Beginπ name := BBSArray[BBSCount].BBSName;π number := BBSArray[BBSCount].BBSPhone;π baud := 5;π parity := 0;π data := 8;π stop := 1;π script := tscript;π lastcall := tlastcall;π totcalls := 0;π terminal := 1;π protocol := 'Z';π toggles := 0000;π filler1 := 'A';π filler2 := 'B';π dprefnum := 1;π password := tpassword;π end;π end;ππ BlockWrite(FonFile, DDF_Header, SizeOf(DDF_Header));ππ For BBSCount := 1 to BBSNumber doπ Beginπ BlockWrite(FonFile, DD_Entry[BBSCount], SizeOf(DD_entry[BBSCount]));π {This could be the wrong way of doing it?}π Inc(BBSCount);π end;πππ Close(Fonfile);ππend;ππ
