├── swagindex.css ├── swagsource.css ├── zip.png ├── dos ├── dir.txt ├── index.html ├── 0024.pas ├── 0082.pas ├── 0023.pas ├── 0088.pas ├── 0033.pas ├── 0030.pas ├── 0098.pas ├── 0057.pas ├── 0003.pas ├── 0080.pas ├── 0028.pas └── 0063.pas ├── math ├── dir.txt ├── index.html ├── 0007.pas ├── 0006.pas ├── 0101.pas ├── 0123.pas ├── 0013.pas ├── 0037.pas ├── 0004.pas ├── 0069.pas ├── 0091.pas ├── 0056.pas └── 0035.pas ├── misc ├── dir.txt ├── index.html ├── 0110.pas ├── 0072.pas ├── 0050.pas ├── 0120.pas ├── 0014.pas ├── 0002.pas ├── 0052.pas ├── 0151.pas ├── 0040.pas └── 0042.pas ├── delphi ├── dir.txt ├── index.html ├── 0161.pas ├── 0063.pas ├── 0388.pas ├── 0377.pas ├── 0102.pas ├── 0375.pas ├── 0393.pas ├── 0060.pas ├── 0016.pas ├── 0107.pas ├── 0187.pas ├── 0019.pas ├── 0308.pas ├── 0204.pas ├── 0197.pas ├── 0302.pas ├── 0025.pas ├── 0365.pas ├── 0321.pas ├── 0026.pas ├── 0001.pas ├── 0383.pas ├── 0218.pas ├── 0151.pas ├── 0326.pas ├── 0430.pas ├── 0271.pas ├── 0241.pas ├── 0380.pas ├── 0436.pas ├── 0008.pas ├── 0053.pas ├── 0155.pas ├── 0015.pas ├── 0226.pas ├── 0296.pas ├── 0400.pas ├── 0389.pas ├── 0099.pas ├── 0054.pas ├── 0043.pas ├── 0035.pas ├── 0368.pas ├── 0112.pas ├── 0378.pas ├── 0366.pas ├── 0222.pas ├── 0215.pas ├── 0114.pas ├── 0220.pas ├── 0354.pas ├── 0065.pas ├── 0007.pas ├── 0029.pas ├── 0307.pas ├── 0056.pas └── 0227.pas ├── drives ├── dir.txt ├── index.html ├── 0007.pas ├── 0004.pas ├── 0084.pas ├── 0051.pas ├── 0006.pas ├── 0016.pas ├── 0109.pas ├── 0076.pas ├── 0039.pas ├── 0041.pas └── 0074.pas ├── encrypt ├── dir.txt ├── index.html └── 0004.pas ├── numbers ├── dir.txt ├── index.html ├── 0051.pas ├── 0003.pas ├── 0077.pas ├── 0007.pas ├── 0022.pas ├── 0006.pas ├── 0028.pas ├── 0027.pas └── 0010.pas ├── screen ├── dir.txt ├── index.html ├── 0099.pas ├── 0086.pas ├── 0002.pas ├── 0038.pas ├── 0009.pas ├── 0040.pas ├── 0029.pas ├── 0048.pas ├── 0054.pas ├── 0052.pas ├── 0027.pas ├── 0015.pas └── 0039.pas ├── sound ├── dir.txt ├── index.html ├── 0015.pas ├── 0008.pas └── 0026.pas ├── datetime ├── dir.txt ├── index.html ├── 0006.pas ├── 0031.pas ├── 0013.pas ├── 0018.pas ├── 0046.pas └── 0055.pas ├── textfile ├── dir.txt ├── index.html ├── 0070.pas └── 0006.pas ├── turtle ├── GRAPHP.TXT ├── KORPIC.TXT ├── LOTTRP.TXT ├── MYSPIC.TXT ├── REKPIC.TXT ├── READ.ME.zip ├── GRAPHP.TXT.zip ├── KORPIC.TXT.zip ├── LOTTRP.TXT.zip ├── MYSPIC.TXT.zip └── REKPIC.TXT.zip ├── crt ├── 0016.pas ├── 0022.pas ├── 0024.pas ├── 0003.pas ├── 0005.pas ├── 0032.pas ├── 0034.pas ├── 0006.pas ├── 0012.pas ├── 0020.pas ├── 0013.pas ├── 0037.pas └── 0004.pas ├── hardware ├── 0055.pas ├── 0017.pas ├── 0040.pas ├── 0059.pas ├── 0022.pas ├── 0027.pas ├── 0003.pas ├── 0007.pas ├── 0032.pas ├── 0043.pas ├── 0031.pas └── 0011.pas ├── egavga ├── 0090.pas ├── 0022.pas ├── 0070.pas ├── 0181.pas ├── 0062.pas ├── 0111.pas ├── 0057.pas ├── 0061.pas ├── 0104.pas ├── 0108.pas ├── 0220.pas ├── 0132.pas ├── 0012.pas ├── 0008.pas ├── 0011.pas ├── 0025.pas ├── 0225.pas └── 0275.pas ├── comm ├── 0061.pas ├── 0051.pas ├── 0019.pas ├── 0020.pas ├── 0005.pas ├── 0075.pas ├── 0064.pas ├── 0018.pas ├── 0080.pas ├── 0085.pas ├── 0010.pas └── 0002.pas ├── strings ├── 0008.pas ├── 0027.pas ├── 0074.pas ├── 0015.pas ├── 0125.pas ├── 0031.pas ├── 0004.pas ├── 0002.pas ├── 0085.pas ├── 0001.pas ├── 0131.pas ├── 0029.pas ├── 0053.pas ├── 0056.pas ├── 0006.pas └── 0034.pas ├── exec ├── 0002.pas └── 0027.pas ├── color ├── 0017.pas ├── 0003.pas ├── 0008.pas ├── 0011.pas ├── 0001.pas └── 0016.pas ├── textedit ├── 0002.pas └── 0001.pas ├── keyboard ├── 0111.pas ├── 0039.pas ├── 0112.pas ├── 0045.pas ├── 0051.pas ├── 0092.pas ├── 0046.pas ├── 0062.pas ├── 0094.pas ├── 0052.pas ├── 0071.pas └── 0121.pas ├── printing ├── 0043.pas ├── 0002.pas ├── 0048.pas ├── 0035.pas └── 0022.pas ├── memory ├── 0058.pas ├── 0052.pas ├── 0006.pas ├── 0070.pas ├── 0044.pas ├── 0028.pas ├── 0104.pas ├── 0084.pas └── 0023.pas ├── ansi ├── 0037.pas ├── 0016.pas ├── 0011.pas └── 0006.pas ├── cursor ├── 0007.pas ├── 0028.pas ├── 0027.pas ├── 0004.pas ├── 0006.pas ├── 0014.pas ├── 0015.pas ├── 0022.pas ├── 0013.pas └── 0016.pas ├── network ├── 0005.pas └── 0017.pas ├── textwndw ├── 0010.pas └── 0023.pas ├── cmdline ├── 0004.pas └── 0002.pas ├── files ├── 0004.pas ├── 0064.pas ├── 0028.pas ├── 0007.pas └── 0002.pas ├── records └── 0013.pas ├── win-os2 └── 0033.pas ├── dirs ├── 0060.pas ├── 0032.pas ├── 0044.pas └── 0056.pas ├── desqview └── dir.txt ├── copymove ├── 0009.pas ├── 0013.pas └── 0001.pas ├── datatype ├── 0004.pas └── 0017.pas ├── chars └── 0004.pas ├── timing ├── 0002.pas ├── 0004.pas ├── 0036.pas ├── 0031.pas └── 0012.pas ├── unitinfo └── dir.txt ├── pointers ├── 0006.pas ├── 0024.pas └── 0008.pas ├── savescrn └── 0007.pas ├── joystick └── 0004.pas ├── graphics ├── 0214.pas ├── 0055.pas ├── 0232.pas └── 0118.pas ├── mouse ├── 0035.pas └── 0037.pas ├── isr └── dir.txt ├── oop └── 0065.pas ├── streams └── dir.txt ├── interrup ├── 0005.pas └── 0003.pas ├── redirect └── dir.txt ├── tsr └── 0035.pas ├── archives └── 0031.pas ├── faq ├── 0004.pas └── 0032.pas ├── menu └── 0005.pas ├── default.css ├── parsing └── 0004.pas ├── entry └── 0030.pas └── sorting └── 0004.pas /swagindex.css: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /swagsource.css: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /zip.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/zip.png -------------------------------------------------------------------------------- /dos/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/dos/dir.txt -------------------------------------------------------------------------------- /math/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/math/dir.txt -------------------------------------------------------------------------------- /misc/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/misc/dir.txt -------------------------------------------------------------------------------- /delphi/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/delphi/dir.txt -------------------------------------------------------------------------------- /dos/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/dos/index.html -------------------------------------------------------------------------------- /drives/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/drives/dir.txt -------------------------------------------------------------------------------- /encrypt/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/encrypt/dir.txt -------------------------------------------------------------------------------- /math/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/math/index.html -------------------------------------------------------------------------------- /misc/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/misc/index.html -------------------------------------------------------------------------------- /numbers/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/numbers/dir.txt -------------------------------------------------------------------------------- /screen/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/screen/dir.txt -------------------------------------------------------------------------------- /sound/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/sound/dir.txt -------------------------------------------------------------------------------- /datetime/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/datetime/dir.txt -------------------------------------------------------------------------------- /delphi/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/delphi/index.html -------------------------------------------------------------------------------- /drives/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/drives/index.html -------------------------------------------------------------------------------- /screen/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/screen/index.html -------------------------------------------------------------------------------- /sound/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/sound/index.html -------------------------------------------------------------------------------- /textfile/dir.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/textfile/dir.txt -------------------------------------------------------------------------------- /turtle/GRAPHP.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/GRAPHP.TXT -------------------------------------------------------------------------------- /turtle/KORPIC.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/KORPIC.TXT -------------------------------------------------------------------------------- /turtle/LOTTRP.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/LOTTRP.TXT -------------------------------------------------------------------------------- /turtle/MYSPIC.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/MYSPIC.TXT -------------------------------------------------------------------------------- /turtle/REKPIC.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/REKPIC.TXT -------------------------------------------------------------------------------- /datetime/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/datetime/index.html -------------------------------------------------------------------------------- /encrypt/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/encrypt/index.html -------------------------------------------------------------------------------- /numbers/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/numbers/index.html -------------------------------------------------------------------------------- /textfile/index.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/textfile/index.html -------------------------------------------------------------------------------- /turtle/READ.ME.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/READ.ME.zip -------------------------------------------------------------------------------- /turtle/GRAPHP.TXT.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/GRAPHP.TXT.zip -------------------------------------------------------------------------------- /turtle/KORPIC.TXT.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/KORPIC.TXT.zip -------------------------------------------------------------------------------- /turtle/LOTTRP.TXT.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/LOTTRP.TXT.zip -------------------------------------------------------------------------------- /turtle/MYSPIC.TXT.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/MYSPIC.TXT.zip -------------------------------------------------------------------------------- /turtle/REKPIC.TXT.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nickelsworth/swag/HEAD/turtle/REKPIC.TXT.zip -------------------------------------------------------------------------------- /math/0007.pas: -------------------------------------------------------------------------------- 1 | Function NlogX(X: Real; N:Real): Real; 2 | 3 | begin 4 | NlogX = Ln(X) / Ln(N); 5 | end; 6 | 7 |  -------------------------------------------------------------------------------- /delphi/0161.pas: -------------------------------------------------------------------------------- 1 | 2 | var s: string; 3 | begin 4 | FmtStr(s, '%.5d', [StrToInt(edit1.text)]); 5 | edit1.text := s; 6 | end; 7 |  -------------------------------------------------------------------------------- /crt/0016.pas: -------------------------------------------------------------------------------- 1 | procedure ToggleBlink(OnOff:boolean); 2 | assembler; 3 | asm 4 | mov ax,1003h 5 | mov bl,OnOff 6 | int 10h 7 | end; 8 |  -------------------------------------------------------------------------------- /hardware/0055.pas: -------------------------------------------------------------------------------- 1 | 2 | procedure warme_start; 3 | 4 | Begin 5 | Inline($BB/$00/$01/$B8/$40/$00/$8E/$D8/ 6 | $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF); 7 | End; 8 |  -------------------------------------------------------------------------------- /egavga/0090.pas: -------------------------------------------------------------------------------- 1 | 2 | Procedure SetBank(b : byte); Assembler; {vesa} 3 | Asm 4 | mov AX, 4f05h 5 | xor DX, DX 6 | mov Dl, b 7 | Int 10h 8 | END; 9 | 10 |  -------------------------------------------------------------------------------- /comm/0061.pas: -------------------------------------------------------------------------------- 1 | { 2 | Set your modem to send a break signal 3 | Then enable break: (assuming COM1) 4 | } 5 | 6 | port[$3fb] := port[$3fb] or $40; 7 | delay(100); 8 | port[$3fb] := port[$3fb] and $bf; 9 |  -------------------------------------------------------------------------------- /hardware/0017.pas: -------------------------------------------------------------------------------- 1 | {Laurent M. CHARTINIER} 2 | {computer do a RESET using a small Pascal routine?} 3 | 4 | Procedure Reboot; 5 | Begin 6 | Asm 7 | JMP FFFF:0000 8 | End; 9 | End; 10 | 11 |  -------------------------------------------------------------------------------- /strings/0008.pas: -------------------------------------------------------------------------------- 1 | Function DnCase(Ch: Char): Char; 2 | Var 3 | n : Byte Absolute ch; 4 | begin 5 | Case ch of 6 | 'A'..'Z': n := n or 32; 7 | end; 8 | DnCase := chr(n); 9 | end; 10 |  -------------------------------------------------------------------------------- /exec/0002.pas: -------------------------------------------------------------------------------- 1 | {$M 4096,0,4096} 2 | 3 | Uses 4 | Dos, Prompt; 5 | 6 | begin 7 | ChangeShellPrompt('Hi There'); 8 | SwapVectors; 9 | Exec(GetEnv('COMSPEC'),''); 10 | SwapVectors; 11 | end. -------------------------------------------------------------------------------- /comm/0051.pas: -------------------------------------------------------------------------------- 1 | 2 | Procedure PurgeInput; assembler; 3 | { Purges the input buffer -- Empties it into obilivion! } 4 | asm 5 | mov AH, $0A 6 | mov DX, port 7 | Int $14 8 | End; 9 | 10 | 11 | 12 |  -------------------------------------------------------------------------------- /crt/0022.pas: -------------------------------------------------------------------------------- 1 | AS> Could someone tell me how to access 80x50 text mode in 2 | AS> Tp 6.0 = mode con lines=50 in dos. 3 | 4 | Uses Crt; 5 | begin 6 | textmode(c80+font8x8); {80x50} 7 | textmode(c80); {80x25} 8 | end. 9 |  -------------------------------------------------------------------------------- /color/0017.pas: -------------------------------------------------------------------------------- 1 | YZ> Does anyone know how to "extract" the Foreground and 2 | YZ> background colours from 3 | YZ> TextAttr? 4 | 5 | or, For simplicity, use: 6 | 7 | FC := TextAttr MOD 16; 8 | BC := TextAttr div 16; 9 | 10 |  -------------------------------------------------------------------------------- /delphi/0063.pas: -------------------------------------------------------------------------------- 1 | 2 | >>Can someone describe how to activate the horizontal scrollbar in a 3 | >>listbox. I need to do this programatically. 4 | 5 | try this: 6 | 7 | sendmessage(ListBox.Handle, LB_SetHorizontalExtent, PixelWidth , 0); 8 |  -------------------------------------------------------------------------------- /numbers/0051.pas: -------------------------------------------------------------------------------- 1 | 2 | Function RandomInteger: Integer; Assembler; 3 | asm 4 | mov ah,2ch 5 | int 21h { Get a random seed from DOS's clock } 6 | imul 9821 7 | inc ax 8 | ror al,1 9 | rol ah,1 { Randomize the seed } 10 | end; 11 |  -------------------------------------------------------------------------------- /textedit/0002.pas: -------------------------------------------------------------------------------- 1 | { Center Text } 2 | 3 | Uses Crt; 4 | Var 5 | s : String; 6 | i : Integer; 7 | begin 8 | Write('String? '); 9 | readln(s); 10 | i := (succ(lo(windmax)) - length(s)) shr 1; 11 | gotoXY(i,10); 12 | Write(s); 13 | end. 14 |  -------------------------------------------------------------------------------- /keyboard/0111.pas: -------------------------------------------------------------------------------- 1 | var 2 | KeyFlags1: Byte absolute $40:$17; 3 | 4 | function InsertOn: Boolean; 5 | begin 6 | InsertOn := (KeyFlags1 and $80) = $80; 7 | end; 8 | 9 | procedure ToggleInsert; 10 | begin 11 | InsertOn := KeyFlags1 xor $80; 12 | end; 13 |  -------------------------------------------------------------------------------- /misc/0110.pas: -------------------------------------------------------------------------------- 1 | { 2 | TIP for DOS compiler users: If you've got Windows for WorkGroups 3 | v3.11 with the 32-bit disk/file access enabled, compile your code 4 | under a Windows "DOS box" instead of vanilla MS-DOS... you may cut 5 | the compiler file i/o time in half. 6 | } -------------------------------------------------------------------------------- /misc/0072.pas: -------------------------------------------------------------------------------- 1 | 2 | {$X+} { Need this for easy handling of Asciiz strings } 3 | var 4 | parentseg : ^word; 5 | p : pchar; 6 | begin 7 | parentseg := ptr(prefixseg,$16); 8 | p := ptr(parentseg^-1,8); 9 | writeln('I was launched by ',p); 10 | end. 11 | 12 |  -------------------------------------------------------------------------------- /delphi/0388.pas: -------------------------------------------------------------------------------- 1 | 2 | var 3 | Dummy : Integer; 4 | begin 5 | SystemParametersInfo (97, Word (True), @Dummy, 0); {no alt-tab or 6 | ctrl-alt-del any more} 7 | SystemParametersInfo (97, Word (False), @Dummy, 0); {Activate alt-tab or 8 | ctrl-alt-del any more} 9 | end; 10 |  -------------------------------------------------------------------------------- /numbers/0003.pas: -------------------------------------------------------------------------------- 1 | { You can use multiplies of 2 like: } 2 | 3 | Function Find_Bit(B, c : Byte) : Byte; 4 | {c is the position c=0 far right c=7 far left 5 | returns 0 or 1} 6 | begin 7 | if b MOD (b shl c) = 0 then Find_Bit := 0 8 | else Find_Bit := 1 9 | end; 10 | 11 |  -------------------------------------------------------------------------------- /printing/0043.pas: -------------------------------------------------------------------------------- 1 | function GetPrinterStatus (LPT: Word): Byte; 2 | {Pass 1 in LPT to see if the printer is hooked up.} 3 | begin 4 | asm 5 | mov ah,2 6 | mov dx,LPT 7 | dec dx 8 | int $17 9 | mov @Result,ah 10 | end; 11 | end; {GetPrinterStatus} 12 |  -------------------------------------------------------------------------------- /crt/0024.pas: -------------------------------------------------------------------------------- 1 | 2 | procedure GoToXY(x,y : word); 3 | begin 4 | asm 5 | mov ax,y 6 | mov dh,al 7 | dec dh 8 | mov ax,x 9 | mov dl,al 10 | dec dl 11 | mov ah,2 12 | xor bh,bh 13 | int 10h 14 | end 15 | end; 16 | 17 |  -------------------------------------------------------------------------------- /dos/0024.pas: -------------------------------------------------------------------------------- 1 | { 2 | FreeWare by Emmanuel CECCHET 3 | (C) 1992 3D CONCEPT PRODUCTION 4 | } 5 | 6 | Procedure Cold_Boot; Assembler; 7 | Asm 8 | mov AX,1700h 9 | int 14h 10 | end; 11 | 12 | Procedure Warm_Boot; Assembler; 13 | Asm 14 | mov AX,1701h 15 | int 14h 16 | end; 17 |  -------------------------------------------------------------------------------- /comm/0019.pas: -------------------------------------------------------------------------------- 1 | FUNCTION Serial_Ports : byte; 2 | { DESCRIPTION: 3 | Gets the number of RS232 ports available in a system. 4 | SAMPLE CALL: 5 | NB := Serial_Ports; } 6 | 7 | BEGIN { Serial_Ports } 8 | Serial_Ports := (MemW[$0000:$0410] shl 4) shr 13; 9 | END; { Serial_Ports } 10 |  -------------------------------------------------------------------------------- /dos/0082.pas: -------------------------------------------------------------------------------- 1 | (* 2 | 3 | > What are the valid characters for a filename in DOS? 4 | 5 | Its in the DOS manual!(DOS 5: page 72) 6 | Valid: 7 | A..Z 0..9 _ ^ $ ~ ! # % & - {} () @ ' ` 8 | 9 | Unvalid: 10 | spaces/periods, 11 | names equal to: CLOCK$ CON AUX COM1,,COM4 NUL PRN 12 | *) 13 |  -------------------------------------------------------------------------------- /misc/0050.pas: -------------------------------------------------------------------------------- 1 | { 2 | MARTIN LARSEN 3 | 4 | There are at least two nice features in BP7: BREAK and CONTINUE: 5 | } 6 | 7 | Repeat 8 | Inc(Count); 9 | if Odd(Count) then Continue; { Go to start of loop } 10 | if Count = 10 then Break; { Go to sentence just after loop } 11 | Until False; 12 |  -------------------------------------------------------------------------------- /delphi/0377.pas: -------------------------------------------------------------------------------- 1 | 2 | Using the following works fine : 3 | 4 | var 5 | dummy : integer; 6 | 7 | To turn Ctrl-Alt-Del and Alt-Tab off : 8 | SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @dummy, 0); 9 | 10 | And to turn it back on: 11 | SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @dummy, 0); 12 |  -------------------------------------------------------------------------------- /dos/0023.pas: -------------------------------------------------------------------------------- 1 | { 2 | BJOERN JOENSSON 3 | 4 | BTW, OS/2 is easy to detect because the major Dos 5 | version # is greater than 10: 6 | } 7 | 8 | Function DetectOs2 : Boolean; 9 | begin 10 | { if you use Tpro, then Write Hi(TpDos.DosVersion) } 11 | DetectOs2 := (Lo(Dos.DosVersion) > 10); 12 | end; 13 |  -------------------------------------------------------------------------------- /textfile/0070.pas: -------------------------------------------------------------------------------- 1 | 2 | Function Measure(FileName : String) : LongInt; 3 | Var Counter : LongInt; 4 | FileHandle: Text; 5 | Begin 6 | Assign(FileHandle,FileName); 7 | Reset(FileHandle); 8 | Counter:=0; 9 | Repeat 10 | Inc(Counter); 11 | Until EOF(FileHandle); 12 | Measure:=Counter; 13 | End; 14 |  -------------------------------------------------------------------------------- /color/0003.pas: -------------------------------------------------------------------------------- 1 | { 2 | > know a good, easy way to detect mono/color? 3 | } 4 | 5 | Program CheckDisplay; 6 | Var 7 | Display: Byte Absolute $40:$10; 8 | 9 | begin 10 | if ((Display and $30) = $30) then 11 | Writeln('Monochrome display') 12 | ELSE 13 | Writeln('Color display'); 14 | end. 15 |  -------------------------------------------------------------------------------- /delphi/0102.pas: -------------------------------------------------------------------------------- 1 | 2 | function GetFileDate(TheFileName: string): string; 3 | var 4 | FHandle: integer; 5 | begin 6 | FHandle := FileOpen(TheFileName, 0); 7 | try 8 | Result := DateTimeToStr(FileDateToDateTime(FileGetDate(FHandle))); 9 | finally 10 | FileClose(FHandle); 11 | end; 12 | end; 13 |  -------------------------------------------------------------------------------- /delphi/0375.pas: -------------------------------------------------------------------------------- 1 | 2 | Another solution (my favorite :-): 3 | 4 | function GetUserName(Var Name:String):Boolean; 5 | var I : integer 6 | begin 7 | I := 100 ; {buffer length} 8 | setlength (Name,I) ; 9 | GetUserName (pchar(Name),I) ; 10 | setlength (Name,I) ; 11 | Result := (I <> 0) ; 12 | end ; 13 | 14 |  -------------------------------------------------------------------------------- /memory/0058.pas: -------------------------------------------------------------------------------- 1 | 2 | 3 | Uses Dos; 4 | 5 | Procedure Flush_Cache; 6 | { This will work with SmartDrive 4.00+ and PC-Cache 8.0+. } 7 | 8 | Var Reg: Registers; 9 | 10 | Begin 11 | Reg.AX:=$4A10; 12 | Reg.BX:=$0001; 13 | Intr($2F,Reg); 14 | End; 15 | 16 | BEGIN 17 | Flush_Cache; 18 | END. 19 | 20 |  -------------------------------------------------------------------------------- /crt/0003.pas: -------------------------------------------------------------------------------- 1 | { 2 | >Does anyone know how to clear the screen Really fast ? 3 | Well, here is some Asm code but I haven't tested it. It should work: 4 | } 5 | 6 | Procedure FastClrScr; Assembler; 7 | Asm 8 | MOV AH,0Fh 9 | INT 10h 10 | MOV AH,0 11 | INT 10h 12 | end; 13 | 14 | begin 15 | FastClrScr; 16 | end. -------------------------------------------------------------------------------- /hardware/0040.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I would like to send one byte of data to the parallel port so I can test 3 | > an interface. What is the easiest way to do this? 4 | } 5 | 6 | Program Send_A_To_LPT1; 7 | Var 8 | PrinterPort:Array[1..4] Of Byte Absolute $40:$8; 9 | Begin 10 | Port[PrinterPort[1]]:=Ord('A'); 11 | End. 12 | 13 |  -------------------------------------------------------------------------------- /ansi/0037.pas: -------------------------------------------------------------------------------- 1 | { 2 | You can use this routine with or without the CRT unit. All output will 3 | be routed through the BIOS. You must have the ANSI.SYS driver loaded in 4 | your config.sys file. 5 | 6 | } 7 | procedure awrite(c : byte); 8 | 9 | begin 10 | asm 11 | mov ah,2; 12 | mov dl,c; 13 | int $21; 14 | end; 15 | end; 16 |  -------------------------------------------------------------------------------- /cursor/0007.pas: -------------------------------------------------------------------------------- 1 | Uses 2 | Dos; 3 | 4 | Procedure FindXY(Var X, Y : Byte; Page : Byte); 5 | {X = Row of Cursor} 6 | {Y = Colum of Cursor} 7 | {Page = Page Nummber} 8 | Var 9 | Regs : Registers; 10 | begin 11 | Regs.Ah := 3; 12 | Regs.Bh := Page; 13 | intr($10, Regs); 14 | X := Regs.Dl; 15 | Y := Regs.Dh; 16 | end; 17 |  -------------------------------------------------------------------------------- /delphi/0393.pas: -------------------------------------------------------------------------------- 1 | 2 | [Vincent Croquette] Use : 3 | 4 | const 5 | MAXPCSIZE = 255; 6 | 7 | var 8 | pcUserName : PChar; 9 | Begin 10 | StrAlloc(pcUserName, MAXPCSIZE) ; 11 | Try 12 | GetUserName(pcUserName, MAXPCSIZE); 13 | ShowMessage(StrPas(pcUserName); 14 | Finally 15 | StrDispose(pcUserName); 16 | End; 17 | End; 18 |  -------------------------------------------------------------------------------- /network/0005.pas: -------------------------------------------------------------------------------- 1 | Var 2 | Fi : File; 3 | 4 | Function ISOpen(Var Fil:File):Boolean; 5 | (* Returns True is File has is open ON A NETWORK!!! *) 6 | Var 7 | P:^Byte; 8 | begin 9 | P:=@Fil; 10 | If P^=0 then IsOpen:=False else IsOpen:=True; 11 | end; 12 | 13 | begin 14 | Assign(Fi,'FileOPEN.PAS'); 15 | Writeln(ISOpen(Fi)); 16 | end. -------------------------------------------------------------------------------- /screen/0099.pas: -------------------------------------------------------------------------------- 1 | 2 | function VidSeg: Word; 3 | var 4 | VidM: ^Byte; 5 | begin 6 | {$iFDEF VER70} 7 | VidM := Ptr(Seg0040,$0049); 8 | if VidM^ = 7 then VidSeg := SegB000 else VidSeg := SegB800; 9 | {$ELSE} 10 | VidM := Ptr($0040,$0049); 11 | if VidM^ = 7 then VidSeg := $B000 else VidSeg := $B800; 12 | {$ENDiF} 13 | end; 14 |  -------------------------------------------------------------------------------- /egavga/0022.pas: -------------------------------------------------------------------------------- 1 | { 2 | MICHAEL NICOLAI 3 | 4 | Re: Plotting a pixel. 5 | In 320x200x256 mode it's very simple: 6 | x : 0 to 319, y : 0 to 199 7 | } 8 | 9 | Procedure Plot(x,y Word; color : Byte); 10 | begin 11 | mem[$A000 : (y * 200 + x)] := color; 12 | end; 13 | 14 | {You mean mem[$A000:y*320+x]:=color; don't you? ????? ($UNTESTED)} 15 |  -------------------------------------------------------------------------------- /textwndw/0010.pas: -------------------------------------------------------------------------------- 1 | { 2 | KELLY SMALL 3 | 4 | >Get the foreground/background/blink attr out of TextAttr. 5 | 6 | Assuming you're using TP/BP: 7 | } 8 | 9 | Procedure GetColor(Var f, b : Byte; Var BlinkOn : Boolean); 10 | begin 11 | f := TextAttr And $F; 12 | b := (TextAttr Shr 4) And 7; 13 | BlinkOn := TextAttr And $80 = $80; 14 | end; 15 |  -------------------------------------------------------------------------------- /cmdline/0004.pas: -------------------------------------------------------------------------------- 1 | Program CommandLine; { CL.PAS } 2 | Var 3 | CharCount, 4 | i :Word; 5 | begin 6 | CharCount := Mem[PrefixSeg:$80]; { number of input Characters} 7 | WriteLn('Input Characters: ', CharCount ); 8 | For i := 1 to CharCount do Write( CHR( Mem[PrefixSeg:$80+i] )); 9 | WriteLn; 10 | end. 11 | 12 | 13 | 14 | 15 |  -------------------------------------------------------------------------------- /files/0004.pas: -------------------------------------------------------------------------------- 1 | if you want to remove the period, and all Characters after it in 2 | a valid Dos Filename, do the following... 3 | 4 | FileName := 'MYFile.TXT'; 5 | Name := Copy(FileName, 1, Pos('.', FileName) - 1); 6 | 7 | That will do it. or you can use FSplit to break out all the 8 | different parts of a Filename/path and get it that way. 9 | 10 |  -------------------------------------------------------------------------------- /misc/0120.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anyone know how TP returns a string from a function? Does it 3 | > return a pointer to the string in AX:DX? I'm writing a data 4 | 5 | BP (and probably TP) return a string at the memory location pointed 6 | to by @Result . @Result is a pointer type, and it's location can 7 | be loaded into registers like LES DI,@Result 8 | } 9 |  -------------------------------------------------------------------------------- /crt/0005.pas: -------------------------------------------------------------------------------- 1 | { 2 | > does anyone have an accurate BAsm Delay routine that is 3 | > compatible With the one in the Crt Unit? please post it... 4 | } 5 | 6 | Procedure Delay(ms : Word); Assembler; 7 | Asm {machine independent Delay Function} 8 | mov ax, 1000; 9 | mul ms; 10 | mov cx, dx; 11 | mov dx, ax; 12 | mov ah, $86; 13 | int $15; 14 | end; 15 |  -------------------------------------------------------------------------------- /screen/0086.pas: -------------------------------------------------------------------------------- 1 | { 2 | >> Well, I'm actually working on a program that uses 3 | >> pkunzip, arj etc too, and I solved it by using another 4 | >> page when unzipping... just change [40h:4Ah] to let's 5 | >> say, 1, and no output should come on your screen.... 6 | } 7 | 8 | Mem[$40:$4A]:=1; 9 | Exec(Filename,Params); {Or whatever} 10 | Mem[$40:$4A]:=0; 11 | 12 |  -------------------------------------------------------------------------------- /datetime/0006.pas: -------------------------------------------------------------------------------- 1 | Procedure TheDate(Var Date:String;Var doW:Integer); 2 | Var 3 | D,M,Y : Integer; 4 | begin 5 | GetDate(Y,M,D,doW); 6 | Date:=chr((M div 10)+48)+chr((M mod 10)+48)+'-'+chr((D div 10)+48+ 7 | chr((D mod 10)+48)+'-'+chr(((Y mod 100) div 10)+48)+ 8 | chr(((Y mod 100) mod 10)+48); 9 | if Date[1]='0' then Date[1]:=' '; 10 | end; 11 |  -------------------------------------------------------------------------------- /memory/0052.pas: -------------------------------------------------------------------------------- 1 | {This copies NumBytes from SourceOfs to DestOfs:} 2 | 3 | Procedure MoveGfxMem(NumBytes, SourceOfs, DestOfs : Word); Assembler; 4 | Asm 5 | push ds 6 | mov ax,0a000h 7 | mov ds,ax 8 | mov es,ax 9 | mov si,SourceOfs 10 | mov di,DestOfs 11 | mov cx,NumBytes 12 | cld 13 | rep movsb 14 | pop ds 15 | End; 16 | 17 |  -------------------------------------------------------------------------------- /comm/0020.pas: -------------------------------------------------------------------------------- 1 | FUNCTION Serial_Time_Out(COM : byte) : byte; 2 | { DESCRIPTION: 3 | Time-Out values for RS232 communications lines. 4 | SAMPLE CALL: 5 | NB := Serial_Time_Out(1); 6 | NOTES: 7 | The allowed values for COM are: 1,2,3 or 4. } 8 | 9 | BEGIN { Serial_Time_Out } 10 | Serial_Time_Out := Mem[$0000:$047C + Pred(COM)]; 11 | END; { Serial_Time_Out } 12 |  -------------------------------------------------------------------------------- /delphi/0060.pas: -------------------------------------------------------------------------------- 1 | 2 | 3 | procedure TForm1.HelpSearch(Sender: TObject); 4 | var 5 | HelpMacro:pchar; 6 | begin 7 | HelpMacro:='Search()'; 8 | with Application do begin 9 | Application.HelpContext(1); 10 | HelpCommand(HELP_COMMAND,longint(HelpMacro)); 11 | end; 12 | end; 13 | 14 |  -------------------------------------------------------------------------------- /egavga/0070.pas: -------------------------------------------------------------------------------- 1 | { 2 | * PROCEDURE WaitRetrace 3 | * 4 | * Waits for a verticle retrace to complete before exiting. Useful 5 | * for reducing flicker in video intensive operations, like color 6 | * cycling. 7 | } 8 | 9 | PROCEDURE WaitRetrace; 10 | begin 11 | while ((Port[$3DA] AND 8) > 0) do; 12 | while ((Port[$3DA] AND 8) = 0) do; 13 | end; 14 |  -------------------------------------------------------------------------------- /ansi/0016.pas: -------------------------------------------------------------------------------- 1 | { 2 | STEVE CONNET 3 | 4 | determine whether ansi.sys is installed 5 | } 6 | 7 | Function LocalAnsiDetected : Boolean; 8 | Var 9 | Dummy : Byte; 10 | begin 11 | Asm 12 | mov ah,1ah { detect ANSI.SYS device driver } 13 | mov al,00h 14 | int 2fh 15 | mov dummy,al 16 | end; 17 | LocalAnsiDetected := Dummy = $FF; 18 | end; 19 |  -------------------------------------------------------------------------------- /delphi/0016.pas: -------------------------------------------------------------------------------- 1 | 2 | >How can you bring an icon to the front (set focus), without actually 3 | >restoring the mainwindow? 4 | 5 | Michael-- 6 | 7 | If the form/app is already minimized, this should do what you want: 8 | 9 | ShowWindow(Form1.Handle, SW_MINIMIZED); 10 | 11 | NB: I have not actually tried this, although I see no reason why it 12 | wouldn't work. 13 | 14 |  -------------------------------------------------------------------------------- /delphi/0107.pas: -------------------------------------------------------------------------------- 1 | { 2 | Q: How can I trap for my own hotkeys? 3 | 4 | A: First: set the form's KeyPreview := true; 5 | 6 | Then, you do something like this: 7 | } 8 | 9 | procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; 10 | Shift: TShiftState); 11 | begin 12 | if (ssCtrl in Shift) and (chr(Key) in ['A', 'a']) then 13 | ShowMessage('Ctrl-A'); 14 | end; 15 |  -------------------------------------------------------------------------------- /screen/0002.pas: -------------------------------------------------------------------------------- 1 | { 2 | >How do you Write a clear screen Procedure in standard pascal for 3 | >the vax system? I talking about a nice clear screen prgm that does't 4 | >scroll everything off the screen. Something that works in a flash.. 5 | } 6 | 7 | Const 8 | clear_screen = CHR(27) + CHR(91) + CHR(50) +CHR(74); 9 | 10 | begin 11 | Write(clear_screen); 12 | readln; 13 | end. -------------------------------------------------------------------------------- /egavga/0181.pas: -------------------------------------------------------------------------------- 1 | { 2 | > How do I clear the screen fast (asm code please) in mode 13h 3 | > (320x200x256)??????? 4 | } 5 | Procedure ClearScreen(Col : Byte); assembler; 6 | asm 7 | mov ax, $A000 8 | mov es, ax 9 | mov cx, 32000 10 | xor di, di 11 | mov al, Col 12 | mov ah, al 13 | rep stosw 14 | end; 15 | { that should do it. It'll clear it to Col } 16 |  -------------------------------------------------------------------------------- /math/0006.pas: -------------------------------------------------------------------------------- 1 | {Greatest common divisor} 2 | Program GCD; 3 | 4 | Var 5 | x, y : Integer; 6 | 7 | begin 8 | read(x); 9 | 10 | While x <> 0 do 11 | begin 12 | read(y); 13 | 14 | While x <> y do 15 | if x > y then 16 | x := x - y 17 | else 18 | y := y - x; 19 | 20 | Write(x); 21 | read(x); 22 | 23 | end; 24 | end. 25 |  -------------------------------------------------------------------------------- /delphi/0187.pas: -------------------------------------------------------------------------------- 1 | 2 | This example shows a message for every element in a listbox that 3 | has been selected by the user. 4 | 5 | procedure TForm1.Button1Click(Sender: TObject); 6 | var 7 | Loop: Integer; 8 | begin 9 | for Loop := 0 to Listbox1.Items.Count - 1 do begin 10 | if Listbox1.Selected[Loop] then 11 | ShowMessage(Listbox1.Items.Strings[Loop]); 12 | end; 13 | end; 14 |  -------------------------------------------------------------------------------- /dos/0088.pas: -------------------------------------------------------------------------------- 1 | { Boot system 2 | If warm is true a warm boot is performed, else a cold boot } 3 | Procedure Boot (Warm:Boolean); 4 | Begin 5 | Asm 6 | sti 7 | cmp Warm, 0 8 | je @cold 9 | mov AX, 0 10 | jmp @boot 11 | @cold: 12 | mov AX, 1 13 | @boot: 14 | mov DS, AX 15 | mov AX, 1234h 16 | mov [0472h], AX 17 | End; 18 | Inline ($EA/$00/$00/$FF/$FF); 19 | End; 20 |  -------------------------------------------------------------------------------- /records/0013.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anyone know how I can find and use the offset of 3 | > a given field in a record? 4 | 5 | AFAIK, you can only use BASM for that. example: 6 | } 7 | 8 | type 9 | XXX=record 10 | A,B,C:byte; 11 | end; 12 | var 13 | W:word; 14 | begin 15 | asm 16 | mov ax,XXX.A 17 | mov W,ax 18 | end; 19 | { W holds now the offset of A in XXX } 20 | end. 21 |  -------------------------------------------------------------------------------- /strings/0027.pas: -------------------------------------------------------------------------------- 1 | Function CompareStr(Str1, Str1 : String) : Boolean; 2 | begin 3 | if (Length(Str1) = Length(Str2)) and (Pos(Str1, Str2) <> 0)) then 4 | CompareStr := True 5 | else 6 | CompareStr := False; 7 | end; 8 | 9 | Function CompareStrContext(Str1, Str2 : String) : Boolean; 10 | begin 11 | CompareStrContext := CompareStr(StUpCase(Str1), StUpCase(Str2)); 12 | end; 13 |  -------------------------------------------------------------------------------- /screen/0038.pas: -------------------------------------------------------------------------------- 1 | { 2 | BRIAN PAPE 3 | 4 | >Mike, thought i would share a different way to clear the screen 5 | >it clears the screen directly and tends to be faster 6 | } 7 | 8 | Procedure ClrScr(attr : Byte; ch : Char); Assembler; 9 | Asm 10 | mov ax, $b800 11 | mov es, ax 12 | xor di, di 13 | mov cx, 80*25 14 | mov ah, attr 15 | mov al, &ch 16 | rep stosw 17 | end; 18 |  -------------------------------------------------------------------------------- /win-os2/0033.pas: -------------------------------------------------------------------------------- 1 | 2 | Function RunningUnderMSWindows : boolean; assembler; 3 | Asm 4 | MOV AX,1600h 5 | INT 2Fh 6 | End; { RunningUnderMSWindows } 7 | 8 | or 9 | 10 | Function RunningUnderMSWindows : boolean; 11 | var Regs : registers; 12 | Begin 13 | Regs.AX := $1600; 14 | Intr($2F, Regs); 15 | RunningUnderMSWindows := Boolean(Regs.AL) 16 | End; { RunningUnderWindows } 17 | 18 |  -------------------------------------------------------------------------------- /keyboard/0039.pas: -------------------------------------------------------------------------------- 1 | { 2 | PER-ERIC LARSSON 3 | 4 | > How do you determine if a key is still held down after another is 5 | > pressed ? KeyPressed returns False after second key is pressed and first 6 | > key is still held down. ?? 7 | 8 | From the helpFile For KEEP : 9 | } 10 | 11 | Procedure Keyclick; interrupt; 12 | begin 13 | if Port[$60] < $80 then 14 | { Only click when key is pressed } 15 |  -------------------------------------------------------------------------------- /crt/0032.pas: -------------------------------------------------------------------------------- 1 | 2 | KF> Is there a way that I can display Char #7 on the screen without the 3 | KF> beep? I'm trying to create an ASCII chart to go with a text font editor 4 | KF> I've written, but this character (and one or two others) keep me from 5 | KF> being able to display all 256 ASCII symbols. Please help... 6 | 7 | simple! 8 | 9 | mem[$b800:X*2+Y*160]:=7; 10 | mem[$b800:x*2+Y*160+1]:=attribute; 11 |  -------------------------------------------------------------------------------- /delphi/0019.pas: -------------------------------------------------------------------------------- 1 | 2 | to determine position of cursor in edit field try this: 3 | 4 | Lpos := SendMessage(memo1.Handle,EM_LINEFROMCHAR,Memo1.SelStart,0); 5 | Cpos := SendMessage(memo1.Handle,EM_LINEINDEX,Lpos,0); 6 | LineLength := SendMessage(memo1.handle, EM_LINELENGTH, Cpos, 0); 7 | CPos := Memo1.SelStart-CPos; 8 | 9 | Lpos=line position 10 | Cpos=Cposition 11 | LineLength = number of chacters in currentline 12 |  -------------------------------------------------------------------------------- /dos/0033.pas: -------------------------------------------------------------------------------- 1 | { 2 | From: CHRIS PRIEDE 3 | Subj: Rebooting... 4 | 5 | issue DOS Flush Buffers call AND reboot } 6 | 7 | procedure SafeReboot; far; assembler; 8 | asm 9 | mov ah, 0Dh 10 | int 21h 11 | xor cx, cx 12 | @1: 13 | push cx 14 | int 28h 15 | pop cx 16 | loop @1 17 | mov ds, cx 18 | mov word ptr [472h], 1234h 19 | dec cx 20 | push cx 21 | push ds 22 | end; 23 |  -------------------------------------------------------------------------------- /egavga/0062.pas: -------------------------------------------------------------------------------- 1 | { 2 | WILLIAM MCBRINE 3 | 4 | > I am looking For a Procedure to clear a screen in mode $13. Writing 5 | > black pixels to each position isn't quite fast enough! 6 | 7 | This assumes that color 0 is black. 8 | } 9 | 10 | Procedure clearmode13; Assembler; 11 | Asm 12 | cld 13 | mov ax, $A000 14 | mov es, ax 15 | xor di, di 16 | xor ah, ah 17 | mov cx, 32000 18 | rep stosw 19 | end; 20 | 21 |  -------------------------------------------------------------------------------- /comm/0005.pas: -------------------------------------------------------------------------------- 1 | { 2 | Author: Sean Palmer 3 | 4 | > Does anyone know how to detect when the modem connects?? Thanks. 5 | 6 | Check For a carrier: (periodically, like 2-4 times per second) 7 | } 8 | 9 | Const 10 | pBase = $3F8; {change For which port you're using} 11 | pMSR = pBase + 6; {modem status register} 12 | 13 | Function carrier : Boolean; 14 | begin 15 | carrier := (port[pMSR] and $80) <> 0; 16 | end; 17 | 18 |  -------------------------------------------------------------------------------- /drives/0007.pas: -------------------------------------------------------------------------------- 1 | Program DriveID; 2 | Uses 3 | Dos; 4 | Const 5 | First : Boolean = True; 6 | Var 7 | Count : Integer; 8 | begin 9 | Write('You have the following Drives: '); 10 | For Count := 3 to 26 do 11 | if DiskSize(Count) > 0 then 12 | begin 13 | if not First then 14 | Write(', '); 15 | First := False; 16 | Write(UpCase(Chr(ord('a') - 1 + Count)),':') 17 | end; 18 | WriteLn; 19 | end. 20 |  -------------------------------------------------------------------------------- /hardware/0059.pas: -------------------------------------------------------------------------------- 1 | { 2 | Hello . My name is Kiss L. Karoly. I am from Rumania. 3 | I love programing!!! 4 | 5 | THE FOLLOWING SMALL PROCEDURE DISABLES THE PASSWORD FROM CMOS } 6 | 7 | PROCEDURE OUTPASSWORD; 8 | BEGIN 9 | ASM 10 | XOR AX,AX 11 | MOV AL,11H 12 | OUT 70H,AL 13 | MOV AL,074H 14 | OUT 71H,AL 15 | XOR AX,AX 16 | MOV AL,2FH 17 | OUT 70H,AL 18 | MOV AL,0C4H 19 | OUT 71H,AL 20 | END; 21 |  -------------------------------------------------------------------------------- /misc/0014.pas: -------------------------------------------------------------------------------- 1 | { 2 | REYNIR STEFANSSON 3 | 4 | For anyone wondering how to reboot a PClone from Within Turbo Pascal: 5 | The Inline code is a far jump to the restart vector at $FFFF:0. 6 | } 7 | 8 | Procedure ColdStart; 9 | begin 10 | MemW[$40:$72] := 0; 11 | Inline($EA/0/0/$FF/$FF); 12 | end; 13 | 14 | Procedure WarmStart; 15 | begin 16 | MemW[$40:$72] := $1234; 17 | Inline($EA/0/0/$FF/$FF); 18 | end; 19 | 20 |  -------------------------------------------------------------------------------- /dirs/0060.pas: -------------------------------------------------------------------------------- 1 | { This function replaces ext of given file name } 2 | { uses Dos } 3 | function ReplaceExt(Name: PathStr; NewExt: ExtStr; 4 | CurDir: Boolean): PathStr; 5 | var 6 | D: DirStr; 7 | N: NameStr; 8 | E: ExtStr; 9 | begin 10 | FSplit(Name, D, N, E); 11 | if NewExt[1] <> '.' then NewExt:= '.' + NewExt; 12 | if CurDir then ReplaceExt:= N + NewExt 13 | else ReplaceExt:= D + N + NewExt; 14 | end; 15 |  -------------------------------------------------------------------------------- /comm/0075.pas: -------------------------------------------------------------------------------- 1 | unit carrier; 2 | { detects carrier on modem line } 3 | 4 | interface 5 | uses dos; 6 | 7 | implementation 8 | 9 | Function carrierDetected( ComPort : byte ) : Boolean; 10 | const 11 | MSR = 6; 12 | BASEPORT : Array[1..4] Of Word = ($03F8, $02F8, $03E8, $02E8); 13 | 14 | begin 15 | CarrierDetected := (Port[basePort[ComPort] + MSR] And 128) <> 128; 16 | {true = no carrier} 17 | end; 18 | 19 | end. 20 |  -------------------------------------------------------------------------------- /strings/0074.pas: -------------------------------------------------------------------------------- 1 | 2 | Procedure RightPas(Var S:String; MaxLen:Byte); 3 | Begin 4 | ASm 5 | LES BX, S; 6 | ESSeg 7 | Mov AL, [ES:BX]; 8 | Xor AH, AH; 9 | Add BX, AX; 10 | @@Loop: 11 | Cmp AL, MaxLen; 12 | Jge @@Done; 13 | Mov Word Ptr [ES:BX],' '; 14 | Inc BX; 15 | 16 | Inc AL; 17 | Jmp @@Loop; 18 | @@Done: 19 | End; 20 |  -------------------------------------------------------------------------------- /cursor/0028.pas: -------------------------------------------------------------------------------- 1 | UNIT CCursor; 2 | 3 | INTERFACE 4 | 5 | CONST 6 | HideCursor: Word = $2607; 7 | NormCursor: Word = $0506; 8 | HalfCursor: Word = $0306; 9 | BlockCursor: Word = $0006; 10 | 11 | PROCEDURE ChangeCursor(Curs: Word); 12 | 13 | IMPLEMENTATION 14 | 15 | PROCEDURE ChangeCursor(Curs: Word); Assembler; 16 | 17 | ASM 18 | MOV Ax,$0100 19 | MOV Cx,Curs 20 | INT $10 21 | END; 22 | 23 | 24 | BEGIN 25 | END. 26 |  -------------------------------------------------------------------------------- /drives/0004.pas: -------------------------------------------------------------------------------- 1 | {│o│ How do I detect active drives in Pascal? My Program would │o║ 2 | │o│ crash if you Typed in a non-existent drive as either │o║ 3 | │o│ source or destination. │o║ 4 | } 5 | Uses Dos; 6 | Var sr : SearchRec; 7 | begin 8 | findfirst('k:\*.*',AnyFile,sr); 9 | if Doserror=0 10 | then Writeln('It is there all right!') 11 | else Writeln('Sorry, could not find it.'); 12 | end. 13 | 14 |  -------------------------------------------------------------------------------- /strings/0015.pas: -------------------------------------------------------------------------------- 1 | { 2 | KELD R. HANSEN 3 | } 4 | 5 | PROCEDURE TidyString(VAR Str : String); ASSEMBLER; 6 | ASM 7 | LES DI,STR 8 | XOR BH,BH 9 | MOV BL,ES:[DI] 10 | LEA DI,[DI+BX+1] 11 | MOV SI,WORD PTR STR-2 12 | NEG BX 13 | LEA CX,[SI+BX] 14 | XOR AL,AL 15 | CLD 16 | REP STOSB 17 | END; 18 | 19 | { 20 | which fills up the garbage after the current string length with zeroes. 21 | } 22 | 23 |  -------------------------------------------------------------------------------- /cursor/0027.pas: -------------------------------------------------------------------------------- 1 | 2 | unit Cursor; 3 | 4 | interface 5 | 6 | const 7 | ThinCursor = $0707; 8 | OvrCursor = $0307; 9 | InsCursor = $0607; 10 | BarCursor = $000D; 11 | HideCursor = $2607; 12 | ShowCursor = $0506; 13 | 14 | procedure SetCursor(Ctype: Word); 15 | 16 | implementation 17 | 18 | procedure SetCursor(Ctype: Word); assembler; 19 | asm 20 | mov ax, $0100 21 | mov cx, CType 22 | int $10 23 | end; 24 | 25 | end. 26 | 27 |  -------------------------------------------------------------------------------- /hardware/0022.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anyone know how to get the hard drive type(s) from CMOS ? 3 | } 4 | 5 | Function GetFixedDrive(DriveNum : Byte) : Byte; Assembler; 6 | Asm 7 | mov al, DriveNum 8 | and al, 1 9 | add al, $19 10 | out $70, al 11 | in al, $71 12 | end; 13 | 14 | { 15 | You specify what drive you want (0/1) and you'll get the 16 | disk type as specified in CMOS. 17 | } 18 | 19 | begin 20 | Writeln(GetFixedDrive(3)); 21 | end. -------------------------------------------------------------------------------- /memory/0006.pas: -------------------------------------------------------------------------------- 1 | { 2 | Does anyone have any routines to find the available memory outside of the 3 | heap ? 4 | } 5 | 6 | Function GetFreeMemory : LongInt; 7 | Var 8 | Regs : Registers; 9 | begin 10 | Regs.AH := $48; 11 | Regs.BX := $FFFF; 12 | Intr($21,Regs); 13 | GetFreeMemory := LongInt(Regs.BX)*16; 14 | end; 15 | { 16 | 17 | This Procedure tries to allocate 1MB memory (what's impossible). 18 | Dos will give you the maximum of free memory back. 19 | } -------------------------------------------------------------------------------- /datetime/0031.pas: -------------------------------------------------------------------------------- 1 | { 2 | From: LIAM STITT 3 | Subj: BASM Get Date 4 | } 5 | 6 | type 7 | DateInfo = record 8 | Year: Word; 9 | Month: Byte; 10 | Day: Byte; 11 | DOW: Byte; 12 | end; 13 | 14 | var 15 | DI: DateInfo; 16 | 17 | procedure GetDate; assembler; 18 | asm 19 | mov ah,2Ah 20 | int 21h 21 | mov DI.Year,cx 22 | mov DI.Month,dh 23 | mov DI.Day,dl 24 | mov DI.DOW,al 25 | end; 26 | 27 |  -------------------------------------------------------------------------------- /delphi/0308.pas: -------------------------------------------------------------------------------- 1 | 2 | Using Windows's LockFileEx and UnlockFileEx functions with the 3 | LOCKFILE_EXCLUSIVE_LOCK flag enabled you can lock exclusively a byte range 4 | within your file. But in your case, it's easier and more efficient create 5 | the file using Windows's OpenFile this way: 6 | 7 | hFile := OpenFile(FileName, ofStruct, OF_CREATE or OF_READWRITE or 8 | OF_SHARE_EXCLUSIVE); 9 | 10 | You'll find more in WIN32.HLP. Good luck! 11 | 12 | Daniel Maltarolli. 13 |  -------------------------------------------------------------------------------- /desqview/dir.txt: -------------------------------------------------------------------------------- 1 | SWAG Title: DESQVIEW ROUTINES 2 | 0001.PAS 05-28-93 13:37 "DESQVIEW.PAS" by SWAG SUPPORT TEAM 3 | 0002.PAS 05-28-93 13:37 "DV-VIDEO.PAS" by SWAG SUPPORT TEAM 4 | 0003.PAS 11-26-93 18:18 "Time SLICES for OS/2 & DV" by FRED COHEN 5 | 0004.PAS 02-09-94 11:50 "DESQVIEW Support Unit" by JOEL BERGEN 6 | 0005.PAS 05-25-94 08:11 "DESQVIEW API Routines" by MIKE DICKSON 7 | 0006.PAS 08-24-94 13:33 "Access to DesqView" by JEFF GUILLAUME 8 | -------------------------------------------------------------------------------- /exec/0027.pas: -------------------------------------------------------------------------------- 1 | { 2 | That won't work, actually. He wants to change the _prompt_ in his 3 | shell. Here's one way: 4 | } 5 | 6 | {$m 4096,0,0} 7 | uses 8 | dos; 9 | 10 | var 11 | f : text; 12 | 13 | begin 14 | assign(f,'chgprmpt.bat'); 15 | rewrite(f); 16 | writeln(f,'@set prompt=Type EXIT to return to '+paramstr(0)+'$g'); 17 | close(f); 18 | 19 | swapvectors; 20 | exec(getenv('COMSPEC'),'/K chgprmpt.bat'); 21 | swapvectors; 22 | end. 23 |  -------------------------------------------------------------------------------- /copymove/0009.pas: -------------------------------------------------------------------------------- 1 | {│o│ I want to make my buffer For the BlockRead command as │o║ 2 | │o│ large as possible. When I make it above 11k, I get an │o║ 3 | │o│ error telling me "too many Variables." │o║ 4 | Use dynamic memory, as in thanks a heap. 5 | } 6 | 7 | 8 | if memavail > maxint { up to 65520 } 9 | then bufsize := maxint 10 | else bufsize := memavail; 11 | if i<128 12 | then Exitmsg('No memory') 13 | else getmem(buf,bufsize); 14 | 15 | 16 |  -------------------------------------------------------------------------------- /datatype/0004.pas: -------------------------------------------------------------------------------- 1 | { 2 | SEAN PALMER 3 | 4 | generic compare Function... 5 | make sure to keep garbage out of Strings (by filling With #0 6 | before storing the Strings) and you can compare ANY data With this. 7 | } 8 | 9 | Function equal(Var m1, m2; siz : Word) : Boolean; Assembler; 10 | Asm 11 | push ds 12 | cld 13 | les di, m1 14 | lds si, m2 15 | mov cx, siz 16 | xor al, al 17 | repe cmpsb 18 | jne @S 19 | inc al 20 | @S: 21 | pop ds 22 | end; 23 |  -------------------------------------------------------------------------------- /delphi/0204.pas: -------------------------------------------------------------------------------- 1 | { 2 | I have several combo boxes that I wish to populate at the form creation. 3 | The problem is that I keep getting duplicate values. 4 | } 5 | 6 | var 7 | SList : TStringList; 8 | begin 9 | SList := TStringList.Create; 10 | SList.sorted := True; 11 | SLIST.Duplicates := dupIgnore; 12 | SList.Add('Dog'); {Only one 'Dog' goes in the list} 13 | SList.Add('cat'); 14 | SList.Add('Dog'); 15 | ComboBox1.Items.Assign(SList); 16 | SList.free; 17 | end; 18 |  -------------------------------------------------------------------------------- /math/0101.pas: -------------------------------------------------------------------------------- 1 | 2 | function percent(p,t:longint):longint; 3 | begin 4 | percent:=trunc(100*(p/t)); 5 | end; 6 | 7 | There you go! :) p is the partial value, t is the total value, as in... 8 | 9 | percent(50,100) = 50% 10 | 11 | If you want it to return a string instead of a longint, do it like this: 12 | 13 | function percent(p,t:longint):string; 14 | var s:string; l:longint; 15 | begin 16 | l:=trunc(100*(p/t)); 17 | str(l,s); 18 | percent:=s+'%'; 19 | end; 20 |  -------------------------------------------------------------------------------- /delphi/0197.pas: -------------------------------------------------------------------------------- 1 | 2 | To the wallpaper in Windows 95 you must use the Win32 3 | API function SystemParametersInfo. SystemParametersInfo retrieves 4 | and sets system wide parameters including the wallpaper. The 5 | code below illustrates setting the wallpaper to the Athena bitmap. 6 | 7 | procedure TForm1.Button1Click(Sender: TObject); 8 | var 9 | s: string; 10 | begin 11 | s := 'c:\windows\athena.bmp'; 12 | SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(s), 0) 13 | end; 14 |  -------------------------------------------------------------------------------- /egavga/0111.pas: -------------------------------------------------------------------------------- 1 | { EM> Does anyone happen to know how to change the border color?} 2 | 3 | const border:boolean=true; 4 | procedure setborder(col:byte); assembler; 5 | asm 6 | xor ch,ch 7 | mov cl,border 8 | jcxz @out 9 | mov dx,3dah 10 | in al,dx 11 | mov dx,3c0h 12 | mov al,11h+32 13 | out dx,al 14 | mov al,col 15 | out dx,al 16 | @out: 17 | end; 18 | 19 | BEGIN 20 | SetBorder(1); { make it blue } 21 | Readln; 22 | SetBorder(0); { back to black } 23 | END. -------------------------------------------------------------------------------- /comm/0064.pas: -------------------------------------------------------------------------------- 1 | { 2 | >I am looking for some code to turn on/off the modem and use 3 | >it to make telephone calls. If you have the code, pleas post 4 | >it if you could. Many thanks. 5 | 6 | I really don't know about making a call, but here are two procs to turn 7 | on/off an internal modem: 8 | } 9 | procedure modem_on; assembler; 10 | asm 11 | mov ax,4401h 12 | int 15h 13 | end; 14 | 15 | procedure modem_off; assembler; 16 | asm 17 | mov ax,4400h 18 | int 15h 19 | end; 20 |  -------------------------------------------------------------------------------- /cursor/0004.pas: -------------------------------------------------------------------------------- 1 | Uses Crt; 2 | 3 | Var 4 | Continue : Char; 5 | 6 | Procedure HideCursor; Assembler; 7 | Asm 8 | MOV ax,$0100 9 | MOV cx,$2607 10 | INT $10 11 | end; 12 | 13 | Procedure ShowCursor; Assembler; 14 | Asm 15 | MOV ax,$0100 16 | MOV cx,$0506 17 | INT $10 18 | end; 19 | 20 | begin 21 | Writeln('See the cursor ?'); 22 | Continue := ReadKey; 23 | HideCursor; 24 | Writeln('Gone! '); 25 | Continue := ReadKey; 26 | ShowCursor; 27 | end. -------------------------------------------------------------------------------- /strings/0125.pas: -------------------------------------------------------------------------------- 1 | function addString(st1,st2 : string):string;assembler; 2 | 3 | asm 4 | push DS 5 | cld 6 | lds SI,st1 7 | les DI,@result 8 | mov BX,DI 9 | lodsb 10 | mov DL,255 11 | sub DL,AL 12 | xor AH,AH 13 | mov CX,AX 14 | stosb 15 | repz 16 | movsb 17 | lds SI,st2 18 | lodsb 19 | cmp AL,DL 20 | jna @nooverflow 21 | mov AL,DL 22 | @nooverflow: 23 | mov CX,AX 24 | repz 25 | movsb 26 | add ES:[BX],AL 27 | pop DS 28 | end; 29 |  -------------------------------------------------------------------------------- /cursor/0006.pas: -------------------------------------------------------------------------------- 1 | Procedure HideCursor; assembler; 2 | asm 3 | mov ah,$01 { Function number } 4 | mov ch,$20 5 | mov cl,$00 6 | Int $10 { Call BIOS } 7 | end; { HideCursor } 8 | 9 | 10 | Procedure RestoreCursor; assembler; 11 | asm 12 | mov ah,$01 { Function number } 13 | mov ch,$06 { Starting scan line } 14 | mov cl,$07 { Ending scan line } 15 | int $10 { Call BIOS } 16 | end; { RestoreCursor } 17 |  -------------------------------------------------------------------------------- /delphi/0302.pas: -------------------------------------------------------------------------------- 1 | 2 | >Hello, 3 | >I know I can use {$IFDEF WIN32} to check for Delphi 2, 4 | >but how can I do conditional compilation for Delphi 3. 5 | > 6 | > 7 | >Thanks in advance, 8 | >Bruno Fierens 9 | Use VER80 for Delphi1, VER90 for Delphi2, VER100 for Delphi3, as: 10 | 11 | {$ifdef VER80} 12 | Showmessage('Delphi 1.0'); 13 | {$endif} 14 | {$ifdef VER90} 15 | Showmessage('Delphi 2.0'); 16 | {$endif} 17 | {$ifdef VER100} 18 | Showmessage('Delphi 3.0'); 19 | {$endif} 20 |  -------------------------------------------------------------------------------- /dos/0030.pas: -------------------------------------------------------------------------------- 1 | (* 2 | From: MIKE DICKSON 3 | Subj: IS There 4DOS 4 | *) 5 | 6 | FUNCTION Running4DOS : Boolean; 7 | VAR Regs : Registers; 8 | begin 9 | With Regs do 10 | begin 11 | ax := $D44D; 12 | bx := $00; 13 | end; 14 | Intr ($2F, Regs); 15 | if Regs.ax = $44DD then Running4DOS := TRUE 16 | else Running4DOS := FALSE 17 | end; 18 | 19 |  -------------------------------------------------------------------------------- /printing/0002.pas: -------------------------------------------------------------------------------- 1 | Uses 2 | Graph, Crt, kasutils,ljGraph; 3 | 4 | Var gd,gm : Integer; 5 | y0,y1,y2,x1,x2 : Integer; 6 | begin 7 | egavga_exe; 8 | gd := detect; 9 | InitGraph(gd,gm,''); 10 | setcolor(10); 11 | line(50,100,431,242); 12 | setcolor(blue); 13 | Y0 := 10; 14 | Y1 := 60; 15 | Y2 := 110; 16 | X1 := 10; 17 | X2 := 50; 18 | Bar3D(X1, Y0, X2, Y1, 10, topOn); 19 | Bar3D(X1, Y1, X2, Y2, 10, topoff); 20 | printpause(False); 21 | readln; 22 | closeGraph; 23 | end. -------------------------------------------------------------------------------- /delphi/0025.pas: -------------------------------------------------------------------------------- 1 | 2 | How do you figure out what line number you are currently 3 | on with a TMemo control? 4 | 5 | The trick is to use the em_LineFromChar message. Try this: 6 | 7 | procedure TMyForm.BitBtn1Click(Sender: TObject); 8 | var 9 | iLine : Integer ; 10 | begin 11 | iLine := Memo1.Perform(em_LineFromChar, $FFFF, 0); 12 | { Note: First line is zero } 13 | messageDlg('Line Number: ' + IntToStr(iLine), mtInformation, 14 | [mbOK], 0 ) ; 15 | end; 16 | 17 | 18 |  -------------------------------------------------------------------------------- /egavga/0057.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anybody know how to wait for the retrace before drawing a new 3 | > screen to eliminate flicker? 4 | 5 | Here's the procedure from a PD unit called SuperVGA (by Steve Madsen): 6 | 7 | Waits for a verticle retrace to complete before exiting. Useful 8 | for reducing flicker in video intensive operations, like color cycling. 9 | } 10 | 11 | PROCEDURE WaitRetrace; 12 | begin 13 | while ((Port[$3DA] AND 8) > 0) do; 14 | while ((Port[$3DA] AND 8) = 0) do; 15 | end; 16 |  -------------------------------------------------------------------------------- /hardware/0027.pas: -------------------------------------------------------------------------------- 1 | 2 | { Anyone have any idea why this won't disable PrtScr? } 3 | 4 | uses 5 | crt,dos; 6 | 7 | var 8 | i : word; 9 | old_status : byte; 10 | prt_status : byte absolute $0040:$0100; { PrtScr status byte } 11 | 12 | begin 13 | old_status:= prt_status; 14 | prt_status:= 1; 15 | for i:= 1 to 20 do writeln(' This is line ',i); 16 | writeln; 17 | writeln('Press PrtScr to test, any other key to exit'); 18 | readkey; 19 | prt_status:= old_status; 20 | end. 21 |  -------------------------------------------------------------------------------- /memory/0070.pas: -------------------------------------------------------------------------------- 1 | { 2 | > You can NOT decrease heap-limit. It does not deallocate the heap even 3 | > if you do. What you need is swapping. 4 | 5 | Can too. Look at the Memory unit, and use "Setmemtop" eg: 6 | } 7 | 8 | uses memory; 9 | var 10 | oldheapend: pointer; 11 | begin 12 | oldheapend := heapend; 13 | heapend := heapptr; 14 | setmemtop(heapend); 15 | { Do whatever since your heap is now at the minimum } 16 | 17 | heapend := oldheapend; 18 | setmemtop(heapend); 19 | End; 20 |  -------------------------------------------------------------------------------- /egavga/0061.pas: -------------------------------------------------------------------------------- 1 | { 2 | SEAN PALMER 3 | 4 | > Yeah, I almost think I learned assembly just to reProgram the Crt 5 | > Unit! (except I can't seem to find out how to get to 50-line mode With 6 | > assembly) 7 | } 8 | 9 | Procedure set50LineMode; Assembler; 10 | Asm 11 | mov ax, $1202 12 | mov bl, $30 13 | int $10 {set 400 scan lines} 14 | mov ax, 3 15 | int $10 {set Text mode} 16 | mov ax, $1112 17 | mov bl, 0 18 | int $10 {load 8x8 font to page 0 block} 19 | end; 20 | 21 |  -------------------------------------------------------------------------------- /chars/0004.pas: -------------------------------------------------------------------------------- 1 | { 2 | Author: A A Olowofoyeku 3 | 4 | As For reading the ASCII stuff from the screen, I have a routine that 5 | allows you to read a Character from any location on the screen. 6 | } 7 | 8 | Uses 9 | Dos; 10 | 11 | {-- read the Character at the cursor and return it as a Char --} 12 | Function ScreenChar : Char; 13 | Var 14 | R : Registers; 15 | begin 16 | FillChar(R, SizeOf(R), 0); 17 | R.AH := 8; 18 | R.BH := 0; 19 | Intr($10, R); 20 | ScreenChar := Chr(R.AL); 21 | end; 22 |  -------------------------------------------------------------------------------- /printing/0048.pas: -------------------------------------------------------------------------------- 1 | 2 | { Untested On } 3 | 4 | FUNCTION PrinterNotReady : BOOLEAN; 5 | VAR Regs : REGISTERS; 6 | BEGIN 7 | PrinterNotReady := TRUE; 8 | FILLCHAR(Regs, SIZEOF(Regs), 00); 9 | WITH Regs DO BEGIN 10 | AX := $0200; 11 | DX := 0; { LPT1 = 0, LPT2 = 1 } 12 | END; 13 | Intr($17, Regs); 14 | IF Regs.AX AND $4000 = 0 THEN BEGIN 15 | IF Regs.AX AND $1000 <> 0 THEN PrinterNotReady := FALSE; 16 | END; 17 | END; 18 | 19 |  -------------------------------------------------------------------------------- /screen/0009.pas: -------------------------------------------------------------------------------- 1 | Uses 2 | Crt; 3 | 4 | Procedure ScrollTextLine (x1, x2 : Integer ; y : Integer ; St : String) ; 5 | begin 6 | While Length(St)<(x2-x1+1) Do 7 | St:=St+' ' ; 8 | While not KeyPressed Do 9 | begin 10 | GotoXY(x1, y) ; 11 | Write(Copy(St, 1, x2-x1+1)) ; 12 | Delay(100) ; 13 | St:=Copy(St, 2, Length(St)-1)+St[1] ; 14 | end ; 15 | end ; 16 | 17 | begin 18 | ClrScr; 19 | TextColor(lightgreen); 20 | scrollTextline(10,60,12,'Hello There!'); 21 | end. -------------------------------------------------------------------------------- /delphi/0365.pas: -------------------------------------------------------------------------------- 1 | 2 | I need to check if a Table exists. I was doing it this way, when the=20 3 | app was strictly local, but now I'm networking it... 4 | 5 | Here is your order ... 6 | 7 | Function GetAliasDir(const stAliasName : String) : String; 8 | var AliamsParams : TStrings; 9 | Begin 10 | AliamsParams := TStringList.Create; 11 | Try 12 | Session.GetAliasParams(stAliasName, AliamsParams); 13 | Result := AliamsParams.Values['PATH']; 14 | Finally 15 | AliamsParams.Free; 16 | End; 17 | End; 18 |  -------------------------------------------------------------------------------- /drives/0084.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Anybody have a quick function that can tell if a diskette has been 3 | > changed? I was just writing a volume label to it then reading that back 4 | > until it changed, but my boss whined about all those disk accesses 5 | > being hard on the drive. 6 | } 7 | 8 | function diskchange(drive:byte;):boolean;Assembler; 9 | asm 10 | Mov AH,16h; 11 | mov DL, Byte Ptr Drive; 12 | Int 13h; 13 | Mov AL, AH; 14 | End; 15 | 16 | { Drive byte is in the range of 0 - 1 for A:- B: ect././. } 17 |  -------------------------------------------------------------------------------- /memory/0044.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anyone know if there is any way to check how much of the stack your 3 | > program is using at any given moment? I have Turbo Debugger if that makes 4 | > a difference. 5 | } 6 | 7 | Function Stackpos : word; assembler; 8 | asm 9 | mov ax,sp 10 | end; 11 | 12 | { 13 | This should give You a indication on how the stack is used - otherwise look 14 | at SP in the registers - It should start of at the size you stated for the 15 | program and shrink down to zero as your program crashes :-) 16 | } -------------------------------------------------------------------------------- /datetime/0013.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I'm doing some date routines and I need to know if it is a leap year to 3 | > validate a date.. A leap year is evenly divisble by 4.. I have no 4 | > idea how to check to see if a remainder is present.. I'm going to try 5 | > to read my manauls and stuff... but I'd appreciate any help! Thanks! 6 | } 7 | 8 | LeapYear := Byte((Year mod 4 = 0) and (Month = 2)); 9 | 10 | if LeapYear = 1 then 11 | if Byte((Year mod 100 = 0) and (Year mod 400 <> 0)) = 1 then 12 | LeapYear := 0; 13 | 14 |  -------------------------------------------------------------------------------- /egavga/0104.pas: -------------------------------------------------------------------------------- 1 | { 2 | SG> ok.. how do you switch from 50 line mode to 25 line mode in assembly, 3 | SG> and vice versa? I've tried many ways, which crash every now and then... 4 | } 5 | To 25 lines: 6 | 7 | Uses crt; 8 | begin 9 | textmode(co80); {co80=3} 10 | end. 11 | 12 | To 50 lines: 13 | procedure vga50; 14 | assembler; 15 | asm 16 | mov ax,1202h 17 | mov bl,30h 18 | int 10h 19 | mov ax,3 20 | int 10h 21 | mov ax,1112h 22 | mov bl,0 23 | int 10h 24 | end; 25 | begin 26 | vga50 27 | end. 28 | 29 |  -------------------------------------------------------------------------------- /comm/0018.pas: -------------------------------------------------------------------------------- 1 | FUNCTION Serial_Base_Addr(COM_Port : byte) : word; 2 | { DESCRIPTION: 3 | Base address for four serial ports. 4 | SAMPLE CALL: 5 | NW := Serial_Base_Addr(1); 6 | RETURNS: 7 | The base address for the specified serial port. 8 | NOTES: 9 | If the port is not used, then the returned value will be 0 (zero). 10 | The aceptable values for COM_Port are: 1,2,3 and 4. } 11 | 12 | BEGIN { Serial_Base_Addr } 13 | Serial_Base_Addr := MemW[$0000:$0400 + Pred(COM_Port) * 2]; 14 | END; { Serial_Base_Addr } 15 |  -------------------------------------------------------------------------------- /delphi/0321.pas: -------------------------------------------------------------------------------- 1 | 2 | > Does someone know how to copy a entire directory ??? 3 | 4 | implementation 5 | uses ShellAPI; 6 | 7 | {$R *.DFM} 8 | 9 | procedure TForm1.Button1Click(Sender: TObject); 10 | var 11 | FOS :TSHFileOpStruct; 12 | begin 13 | with FOS do begin 14 | Wnd := Self.Handle; 15 | wFunc := FO_COPY; 16 | pFrom := 'c:\idapi\*.*'; 17 | pTo := 'c:\test'; 18 | fFlags := FOF_NoConfirmMkDir; 19 | end; 20 | SHFileOperation(FOS); 21 | end; 22 | 23 | Andre H. Artus 24 | andre@oas.co.za 25 |  -------------------------------------------------------------------------------- /keyboard/0112.pas: -------------------------------------------------------------------------------- 1 | Program leds; 2 | Uses Crt; 3 | 4 | Var 5 | l : Byte; 6 | 7 | Procedure led(led: Byte); Assembler; 8 | ASM 9 | mov AL, $ED 10 | out $60, AL 11 | mov CX, $200 12 | @@1: 13 | loop @@1 14 | mov AL, led 15 | out $60, AL 16 | End; 17 | 18 | Begin 19 | l := 1; 20 | While not KeyPressed do 21 | Begin 22 | led(l); 23 | l := l SHL 1; 24 | If l = 8 then l := 1; 25 | Delay(200); 26 | End; 27 | While KeyPressed do ReadKey; 28 | End. 29 |  -------------------------------------------------------------------------------- /screen/0040.pas: -------------------------------------------------------------------------------- 1 | { 2 | SANTERI SALMINEN 3 | 4 | > how can i wait For the vertical retrace, in Pascal. 5 | 6 | Some routines For retraces: 7 | As you can see, $3DA reveals all of them. 8 | } 9 | 10 | Repeat Until Port[$3DA] And 8 = 8; { Wait For Vertical retrace } 11 | Repeat Until Port[$3DA] And 8 = 0; { Wait For the end of Vertical retrace } 12 | Repeat Until Port[$3DA] And 1 = 1; { Wait For Horizontal retrace } 13 | Repeat Until Port[$3DA] And 1 = 0; { Wait For the end of Horizontal retrace } 14 | 15 |  -------------------------------------------------------------------------------- /cursor/0014.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... CsrOff 3 | * Purpose ....... To turn the cursor off 4 | * Parameters .... None 5 | * Returns ....... N/A 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | ****************************************************************************} 10 | PROCEDURE CsrOff; ASSEMBLER; 11 | ASM 12 | MOV AH, 1 13 | MOV CX, 1400h 14 | INT 10h 15 | END; 16 | 17 |  -------------------------------------------------------------------------------- /cursor/0015.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... CsrOn 3 | * Purpose ....... To turn the cursor on 4 | * Parameters .... None 5 | * Returns ....... N/A 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | ****************************************************************************} 10 | PROCEDURE CsrOn; ASSEMBLER; 11 | ASM 12 | MOV AH, 1 13 | MOV CX, 0607h 14 | INT 10h 15 | END; 16 | 17 |  -------------------------------------------------------------------------------- /hardware/0003.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Is there any way to find the size of each allocation Unit in a Hard drive? 3 | } 4 | 5 | Uses Dos; 6 | 7 | Function clustsize (drive : Byte) : Word; 8 | Var 9 | regs : Registers; 10 | begin 11 | regs.cx := 0; {set For error-checking just to be sure} 12 | regs.ax := $3600; {get free space} 13 | regs.dx := drive; {0=current, 1=a:, 2=b:, etc.} 14 | msDos (regs); 15 | clustsize := regs.ax * regs.cx; {cluster size!} 16 | end; 17 | 18 | begin 19 | Writeln(ClustSize(0)); 20 | end. -------------------------------------------------------------------------------- /hardware/0007.pas: -------------------------------------------------------------------------------- 1 | { 2 | Or better yet, the BIOS stores the addresses of the parallel Interfaces 3 | on the system at memory location $0040:$0008. There are four Words 4 | here, allowing up to 4 parallel devices. 5 | -Brian Pape 6 | } 7 | Var 8 | i : Byte; 9 | par : Array[1..4] of Word; 10 | begin 11 | For i := 1 to 4 do 12 | begin 13 | par[i] := Word(ptr($0040, $0008 + (i - 1) * 2)^); 14 | If Par[i] = 0 then 15 | Writeln('Not Found') 16 | else 17 | Writeln(Par[i]); 18 | end; 19 | end. 20 | 21 | 22 |  -------------------------------------------------------------------------------- /delphi/0026.pas: -------------------------------------------------------------------------------- 1 | 2 | Try this: 3 | 4 | procedure TScrnFrm.GrabScreen; 5 | var 6 | 7 | DeskTopDC: HDc; 8 | DeskTopCanvas: TCanvas; 9 | DeskTopRect: TRect; 10 | 11 | begin 12 | DeskTopDC := GetWindowDC(GetDeskTopWindow); 13 | DeskTopCanvas := TCanvas.Create; 14 | DeskTopCanvas.Handle := DeskTopDC; 15 | 16 | DeskTopRect := Rect(0,0,Screen.Width,Screen.Height); 17 | 18 | ScrnForm.Canvas.CopyRect(DeskTopRect,DeskTopCanvas,DeskTopRect); 19 | 20 | ReleaseDC(GetDeskTopWindow,DeskTopDC); 21 | end; 22 |  -------------------------------------------------------------------------------- /misc/0002.pas: -------------------------------------------------------------------------------- 1 | REYNIR STEFANSSON 2 | 3 | > Does anyone know of any way to convert a .TPU to a .BIN File to 4 | > use BIN2OBJ.EXE and then load it as an external? Any help 5 | > appreciated... 6 | 7 | It's a bit round-the-block, but you might get some exercise out of it, 8 | assuming you have the source code: 9 | 10 | 1) Smash the source into C With a code converter. 11 | 12 | 2) Declare the Procedures as `void far PASCAL' and the Functions as 13 | `appropriate_Type far PASCAL'. 14 | 15 | 3) Compile it With Turbo C or similar. 16 | 17 |  -------------------------------------------------------------------------------- /timing/0002.pas: -------------------------------------------------------------------------------- 1 | Unit tctimer; 2 | 3 | Interface 4 | Uses tptimer; 5 | 6 | Var 7 | start : LongInt; 8 | 9 | Procedure StartTimer; 10 | 11 | Procedure WriteElapsedTime; 12 | 13 | 14 | 15 | Implementation 16 | 17 | Procedure StartTimer; 18 | begin 19 | start := ReadTimer; 20 | end; 21 | 22 | Procedure WriteElapsedTime; 23 | Var stop : LongInt; 24 | begin 25 | stop := ReadTimer; 26 | Writeln('Elapsed time = ',(ElapsedTime(start,stop) / 1000):10:6,' seconds'); 27 | end; 28 | 29 | 30 | end. 31 |  -------------------------------------------------------------------------------- /crt/0034.pas: -------------------------------------------------------------------------------- 1 | 2 | { Do you think this function would work faster than the Pascal CLRSCR? } 3 | 4 | PROGRAM CLEAR; 5 | 6 | Uses CRT; 7 | 8 | VAR 9 | Attrib : Byte; 10 | 11 | BEGIN 12 | TextBackground(1); { I fill the screen with blue to see } 13 | CLRSCR; { the asm code work.. :) } 14 | Attrib := 15 + 0 * 16; 15 | asm 16 | mov ah, 09h 17 | mov al, 32 18 | mov bh, 00h 19 | mov bl, byte ptr Attrib 20 | mov cx, 2000 21 | Int 10h 22 | end; 23 | END. 24 |  -------------------------------------------------------------------------------- /delphi/0001.pas: -------------------------------------------------------------------------------- 1 | 2 | Here's an easy way to do it: 3 | create a timer and put this code in the OnTimer event: 4 | 5 | var Trk, Min, Sec: Word; 6 | begin 7 | with MediaPlayer1 do 8 | begin 9 | Trk:= MCI_TMSF_TRACK(Position); 10 | Min:=MCI_TMSF_MINUTE(Position); 11 | Sec:=MCI_TMSF_SECOND(Position); 12 | Label1.Caption:=Format('%.2d',[Trk]); 13 | Label2.Caption:=Format('%.2d:%.2d',[Min,Sec]); 14 | end; 15 | end; 16 | 17 | 18 | Add MMSystem to the uses clause in Unit1 19 | This will show current track and time. 20 | Hope it actually works?!?! 21 |  -------------------------------------------------------------------------------- /delphi/0383.pas: -------------------------------------------------------------------------------- 1 | 2 | Since I installed IE4, some of my mails are sometime removed without a = 3 | warning. Anybody knows why?. May be I just miss a simple setup. =20 4 | 5 | Here is the code to use to drag a component on a form at run-time.=20 6 | 7 | procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton; 8 | Shift: TShiftState; X, Y: Integer); 9 | const 10 | SC_DragMove =$F012; // what a number 11 | begin 12 | ReleaseCapture; // See Win32 API help 13 | Button1.perform(WM_SysCommand, SC_DragMove, 0); 14 | end. 15 | 16 |  -------------------------------------------------------------------------------- /files/0064.pas: -------------------------------------------------------------------------------- 1 | 2 | Uses Crt,Dos,Strings; 3 | 4 | VAR 5 | filename : pChar; 6 | fname : String; 7 | 8 | { test to see if file exists } 9 | function FileExists(FileName:pchar):boolean; 10 | inline( 11 | $5A/ 12 | $58/ 13 | $1E/ 14 | $8E/$D8/ 15 | $B8/$00/$43/ 16 | $CD/$21/ 17 | $1F/ 18 | $72/$08/ 19 | $B8/$01/$00/ 20 | $F6/$C1/$10/ 21 | $74/$02/ 22 | $31/$C0); 23 | 24 | BEGIN 25 | fname := Paramstr(1); 26 | WriteLn(FileExists(strPCopy(Filename,fname))); 27 | END. 28 |  -------------------------------------------------------------------------------- /keyboard/0045.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... ClearKBBuffer 3 | * Purpose ....... To clear the keyboard buffer of pending keystrokes 4 | * Parameters .... None 5 | * Returns ....... N/A 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | ****************************************************************************} 10 | PROCEDURE ClearKBBuffer; 11 | BEGIN 12 | WHILE KEYPRESSED DO IF ReadKey = #0 THEN; 13 | END; 14 |  -------------------------------------------------------------------------------- /numbers/0077.pas: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Bit 5 | 7 6 5 4 3 2 1 0 6 | 7 | 128 064 032 016 008 004 002 001 8 | 9 | TO check IF the last bit (7) is on OR off, you can DO something like.. 10 | 11 | FUNCTION isBitOn (n, b : BYTE) : BOOLEAN; 12 | BEGIN isBitOn := ( (n SHR b) AND 1) = 1 END; 13 | 14 | TO SET a specific bit TO on, DO something like... 15 | 16 | PROCEDURE setBitOn (VAR n : BYTE;b : BYTE); 17 | BEGIN n := n OR (1 SHL b) END; 18 | 19 | PROCEDURE toggleBit (VAR n : BYTE;b : BYTE); 20 | BEGIN n := n XOR (1 SHL b) END; 21 | 22 |  -------------------------------------------------------------------------------- /dos/0098.pas: -------------------------------------------------------------------------------- 1 | { >>> Does anyone know how I can get the size of a file? } 2 | 3 | function GetFileTime(FileName: string): longint; 4 | var 5 | Srec: SearchRec; 6 | begin 7 | FindFirst(FileName, $01+$04+$20, Srec); 8 | if DosError = 0 then GetFileTime := Srec.Time 9 | else GetFileTime := 0; 10 | end; 11 | 12 | function GetFileSize(FileName: string): longint; 13 | var 14 | Srec: SearchRec; 15 | begin 16 | FindFirst(FileName, $01+$04+$20, Srec); 17 | if DosError = 0 then GetFileSize := Srec.Size 18 | else GetFileSize := 0; 19 | end; 20 |  -------------------------------------------------------------------------------- /egavga/0108.pas: -------------------------------------------------------------------------------- 1 | { 2 | AG> Does anyone out there know how to set the screen display for 28 rows, in 3 | AG> VGA mode? I've seen this in a couple of programs, and really like it. 4 | 5 | Here goes a small assembly routine to switch the screen to 28-line mode. } 6 | 7 | MOV AX,1202 ;set up 400 scan lines 8 | MOV BL,30 9 | INT 10 10 | MOV AX,0003 ;set up normal text mode 11 | INT 10 12 | MOV AX,1111 ;load ega character set 13 | MOV BL,00 14 | INT 10 15 | 16 |  -------------------------------------------------------------------------------- /hardware/0032.pas: -------------------------------------------------------------------------------- 1 | 2 | VAR 3 | Model : BYTE ABSOLUTE $F000:$FFFE; 4 | 5 | BEGIN 6 | CASE Model OF 7 | $9A : WriteLn( 'COMPAQ Plus' ); 8 | $FF : WriteLn( 'IBM PC' ); 9 | $FE : WriteLn( 'PC XT, Portable PC' ); 10 | $FD : WriteLn( 'PCjr' ); 11 | 12 | $FC : WriteLn( 'Personal Computer AT, PS/2 Models 50 and 60' ); 13 | $FB : WriteLn( 'PC XT (after 1/10/86)' ); 14 | $FA : WriteLn( 'PS/2 Model 30' ); 15 | $F9 : WriteLn( 'Convertible PC' ); 16 | $F8 : WriteLn( 'PS/2 Model 80' ); 17 | End; 18 | END. 19 |  -------------------------------------------------------------------------------- /delphi/0218.pas: -------------------------------------------------------------------------------- 1 | 2 | Windows API function: 3 | 4 | BOOL GetUserName( 5 | 6 | LPTSTR lpBuffer, // address of name buffer 7 | LPDWORD nSize // address of size of name buffer 8 | ); 9 | 10 | Delphi example: 11 | 12 | procedure X; 13 | var 14 | USize : DWORD; 15 | pUName : pchar; 16 | sUName:string; 17 | begin 18 | USize := 30; 19 | getmem(pUName, USize); 20 | if GetUserName(pUName, USize) then 21 | sUserName := StrPas(pUName) 22 | else 23 | sUserName := 'Unknown'; 24 | freemem( pUName, USize ); 25 | end; 26 |  -------------------------------------------------------------------------------- /delphi/0151.pas: -------------------------------------------------------------------------------- 1 | 2 | Row := SendMessage(MyMemo.Handle, EM_LINEFROMCHAR, $FFFF, 0); 3 | 4 | will return the line number of the caret position in variable Row. 5 | 6 | RowStart := SendMessage(MyMemo.Handle, EM_LINEINDEX, $FFFF, 0); 7 | 8 | will return the character index of the start of the line. 9 | Subtract RowStart from MyMemo.SelStart to get the column position. 10 | 11 | MyRow := SendMessage(MyMemo.Handle, EM_LINEFROMCHAR, $FFFF, 0); 12 | MyRowStart := SendMessage(MyMemo.Handle, EM_LINEINDEX, $FFFF, 0); 13 | MyCol := MyMemo.SelStart - MyRowStart; 14 | 15 |  -------------------------------------------------------------------------------- /math/0123.pas: -------------------------------------------------------------------------------- 1 | 2 | I use the following function to calculate present value: 3 | 4 | function PresentValue(FV, IR, PMT : Real; N : Integer) : Real; 5 | var 6 | IFactor, IFactor1, R1, R2 : Real; 7 | begin 8 | {set values of variables} 9 | IFactor := (IR / 1200.0); 10 | IFactor1 := (1.0 + IFactor); 11 | R1 := Exp(-N * LN(IFactor1)); 12 | R2 := ((FV * IFactor) - (-PMT)) + ((Exp(N * LN(IFactor1))) * (-PMT)); 13 | {calc the result} 14 | PresentValue := ((R1 * R2) / IFactor); 15 | end; 16 | 17 | 18 |  -------------------------------------------------------------------------------- /delphi/0326.pas: -------------------------------------------------------------------------------- 1 | 2 | >Is there an easy way to do multi-line 3 | >captions on a TButton? 4 | 5 | var 6 | btn:Longint 7 | 8 | 9 | btn:=GetWindowLong(Button1.Handle,GWL_STYLE); 10 | SetWindowLong(Button1.Handle,GWL_STYLE,btn or BS_MULTILINE); 11 | Button1.Caption := 'This is a multi-line Button'; 12 | 13 | -or- 14 | 15 | SendMessage(Button1.Handle, BM_SETSTYLE, BS_MULTILINE,1); 16 | Button1.Caption := 'This is a multi-line Button'; 17 | 18 | 19 | But the second didn't seem to want to re-draw the button with 20 | the Multiline Caption. Any ideas? 21 |  -------------------------------------------------------------------------------- /drives/0051.pas: -------------------------------------------------------------------------------- 1 | { 2 | WIM VAN VOLLENHOVEN 3 | 4 | >No, I'm looking for an generic CD-ROM detection routine. 5 | >Thought it was some subfunction of int 2Fh. Don't know if it detected 6 | >the presence of a CD-Rom, or the presence of MSCDEX. 7 | } 8 | Uses 9 | Dos; 10 | 11 | Var 12 | Regs : Registers; 13 | 14 | Procedure IsCDRom; 15 | begin 16 | Regs.AX := $1500; 17 | Regs.BX := $0000; 18 | Regs.CX := $0000; 19 | Intr( $2F, Regs); 20 | writeln('CD Available : ', (Regs.BX > 0)); 21 | end; 22 | 23 | 24 | begin 25 | IsCDRom; 26 | end. 27 |  -------------------------------------------------------------------------------- /strings/0031.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... Command 3 | * Purpose ....... To return the command line as a string 4 | * Parameters .... None 5 | * Returns ....... The entire command line as one string 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | FUNCTION Command: STRING; 11 | BEGIN 12 | Command := STRING( PTR(PREFIXSEG, $0080)^ ); 13 | END; 14 | 15 |  -------------------------------------------------------------------------------- /unitinfo/dir.txt: -------------------------------------------------------------------------------- 1 | SWAG Title: UNIT INFORMATION ROUTINES 2 | 0001.PAS 05-28-93 14:09 "DEBUG Information" by SWAG SUPPORT TEAM 3 | 0002.PAS 05-28-93 14:09 "Interface Shell Unit" by SWAG SUPPORT TEAM 4 | 0003.PAS 05-28-93 14:09 "Global Types In UNIT" by SWAG SUPPORT TEAM 5 | 0004.PAS 11-26-94 05:05 "DLL Information" by ANDREW EIGUS 6 | 0005.PAS 08-30-97 10:09 "Show whice version of TP unit" by DOTAN BARAK 7 | 0006.PAS 01-02-98 07:34 "print the dependencies of TP units" by UWE MAEDER 8 | 0007.PAS 01-02-98 07:35 "Code Profiler" by RALF ROSENKRANZ 9 | -------------------------------------------------------------------------------- /pointers/0006.pas: -------------------------------------------------------------------------------- 1 | Program Test_Pointers; 2 | 3 | Type 4 | Array_Pointer = ^MyArray; 5 | MyArray = Array[1..10] of String; 6 | 7 | Var 8 | MyVar : Array_Pointer; 9 | 10 | begin 11 | Writeln('Memory beFore initializing Variable : ',MemAvail); 12 | 13 | New(MyVar); 14 | 15 | Writeln('Memory after initializiation : ',MemAvail); 16 | 17 | MyVar^[1] := 'Hello'; 18 | MyVar^[2] := 'World!'; 19 | 20 | Writeln(MyVar^[1], ' ', MyVar^[2]); 21 | 22 | Dispose(MyVar); 23 | 24 | Writeln('Memory after Variable memory released : ',MemAvail); 25 | end. 26 |  -------------------------------------------------------------------------------- /sound/0015.pas: -------------------------------------------------------------------------------- 1 | { BILL BUCHANAN } 2 | 3 | Uses 4 | Crt; 5 | 6 | Procedure OpenWhistle; 7 | Var 8 | Frequency : Integer; 9 | begin 10 | For Frequency := 500 to 1000 do 11 | begin 12 | Delay(1); 13 | Sound(Frequency) 14 | end; 15 | NoSound 16 | end; 17 | 18 | Procedure CloseWhistle; 19 | Var 20 | Frequency: Integer; 21 | begin 22 | For Frequency := 1000 downto 500 do 23 | begin 24 | Delay(1); 25 | Sound(Frequency) 26 | end; 27 | NoSound 28 | end; 29 | 30 | begin 31 | OpenWhistle; 32 | Readln; 33 | CloseWhistle; 34 | end. -------------------------------------------------------------------------------- /strings/0004.pas: -------------------------------------------------------------------------------- 1 | Function FirstOccurence(s : String; 2 | c : Char) : Integer; Assembler; 3 | Asm 4 | CLD 5 | LES DI, s 6 | xor CH, CH 7 | xor AH, AH 8 | MOV CL, ES:[DI] 9 | JCXZ @1 10 | MOV BX, CX 11 | inC DI 12 | MOV AL, c 13 | REPNE SCASB 14 | JCXZ @1 15 | SUB BX, CX 16 | XCHG AX, BX 17 | JMP @2 18 | @1: 19 | xor AX, AX 20 | @2: 21 | end; 22 | 23 | begin { This example returns 7 } 24 | WriteLn(FirstOccurence('smullen met de pet op dat is pas je ware', 'n')); 25 | end. 26 |  -------------------------------------------------------------------------------- /cmdline/0002.pas: -------------------------------------------------------------------------------- 1 | {There are basically two ways of retrieving the command line. One way is to use 2 | the ParamStr Variable: ParamStr(1) contains the first paramter, ParamStr(2) 3 | contains the second parameter etc. Another way is to fetch the entire command 4 | line String from your environment. This can be done as follows: 5 | } 6 | 7 | Program GetCommandLine; 8 | 9 | Type 10 | 11 | PCommandLine = ^TCommandLine; 12 | TCommandLine = String; 13 | 14 | Var 15 | 16 | CommandLine : PCommandLine; 17 | 18 | begin 19 | CommandLine := Ptr ( PrefixSeg, $80 ); 20 | end. 21 |  -------------------------------------------------------------------------------- /delphi/0430.pas: -------------------------------------------------------------------------------- 1 | From: vincze@ti.com (Michael Vincze) 2 | 3 | Try: 4 | 5 | 6 | -------------------------------------------------------------------------------- 7 | 8 | var 9 | Icon : TIcon; 10 | Bitmap : TBitmap; 11 | begin 12 | Icon := TIcon.Create; 13 | Bitmap := TBitmap.Create; 14 | Icon.LoadFromFile('c:\picture.ico'); 15 | Bitmap.Width := Icon.Width; 16 | Bitmap.Height := Icon.Height; 17 | Bitmap.Canvas.Draw(0, 0, Icon ); 18 | Bitmap.SaveToFile('c:\picture.bmp'); 19 | Icon.Free; 20 | Bitmap.Free; 21 | end; 22 |  -------------------------------------------------------------------------------- /math/0013.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anyone have an idea to perForm permutations With pascal 7.0 ? 3 | > As an example finding the number of 5 card hands from a total of 52 car 4 | > Any help would be greatly appreciated. 5 | 6 | } 7 | 8 | Function Permutation(things, atatime : Word) : LongInt; 9 | Var 10 | i : Word; 11 | temp : LongInt; 12 | begin 13 | temp := 1; 14 | For i := 1 to atatime do 15 | begin 16 | temp := temp * things; 17 | dec(things); 18 | end; 19 | Permutation := temp; 20 | end; 21 | 22 | begin 23 | Writeln('7p7 = ',Permutation(7,7)); 24 | end. -------------------------------------------------------------------------------- /misc/0052.pas: -------------------------------------------------------------------------------- 1 | { ANDY MCFARLAND } 2 | 3 | Var 4 | pick : Array [1..52] of Byte; 5 | i, n, 6 | temp : Word; 7 | 8 | begin 9 | { start With an ordered deck } 10 | For i := 1 to 52 do 11 | pick[i] := i ; 12 | 13 | For i:= 52 downto 2 do 14 | begin { [i+1..52] has been shuffled } 15 | { pick any card in the unshuffled part of the deck } 16 | n := random(i) + 1 ; { N in [1..i] } 17 | temp := pick[n] ; { exchange pick[i] pick[n] } 18 | pick[n] := pick[i] ; 19 | pick[i] := temp ; 20 | end ; 21 | end; 22 |  -------------------------------------------------------------------------------- /savescrn/0007.pas: -------------------------------------------------------------------------------- 1 | { 2 | well.. if you don't mind it not being in assembly, i can help.. 3 | BTW: your 19?? Byte Array wouldn't store the whole screen.. barely half of 4 | it. the color Text screen is 4000 Bytes. 2000 Characters + 2000 attributes 5 | of those Characters. 6 | } 7 | Type 8 | screen = Array[1..4000] of Byte; 9 | Var 10 | scr : screen Absolute $b800:0000; (* or $B000:0000 For Mono *) 11 | scrf : File of screen; 12 | begin 13 | assign(scrf,paramstr(1)); (* or Whatever Filename *) 14 | reWrite(scrf); 15 | Write(scrf,scr); 16 | close(scrf); 17 | end. 18 | 19 |  -------------------------------------------------------------------------------- /screen/0029.pas: -------------------------------------------------------------------------------- 1 | { 2 | SEAN PALMER 3 | 4 | > I want to know how to get and set the screen colors Without using the 5 | > Crt Unit or ansi codes. Any help is appreciated. 6 | 7 | Change the Byte in video memory For the attribute For a Character. 8 | } 9 | 10 | Var 11 | ScreenMem : Array [0..24, 0..79, 0..1] of Char Absolute $B800 : 0; 12 | 13 | Procedure changeColor(x, y, attrib : Byte); 14 | begin 15 | screenMem[y - 1, x - 1, 1] := Char(attrib); 16 | end; 17 | 18 | { For monochrome monitors it's Absolute $B000 : 0; } 19 | begin 20 | ChangeColor(34, 12, $1C); 21 | end. -------------------------------------------------------------------------------- /cursor/0022.pas: -------------------------------------------------------------------------------- 1 | 2 | var crstyp: word; 3 | 4 | procedure cursoff; 5 | 6 | { Turns the cursor off. Stores its format for later redisplaying. } 7 | 8 | begin 9 | asm 10 | mov ah, 03h 11 | mov bh, 00h 12 | int 10h 13 | mov crstyp, cx 14 | mov ah, 01h 15 | mov cx, 65535 16 | int 10h 17 | end; 18 | end; 19 | 20 | procedure curson; 21 | 22 | { Turns the cursor back on, using the cursor display previously stored. } 23 | 24 | begin 25 | asm 26 | mov ah, 01h 27 | mov cx, crstyp 28 | int 10h 29 | end; 30 | end; 31 | 32 |  -------------------------------------------------------------------------------- /delphi/0271.pas: -------------------------------------------------------------------------------- 1 | { 2 | Greetings, Folks! 3 | 4 | Here's a small routine you might find useful. I'm using it to 5 | automatically turn on Num Lock for users of a small billing system here at 6 | the Home. 7 | } 8 | 9 | procedure TFrmMain.SetNumlockTrue(Sender: TObject); 10 | var 11 | CurrentState : Integer; 12 | KeyState : TKeyBoardState; 13 | begin 14 | CurrentState := GetKeyState(vk_numlock); 15 | GetKeyboardState(KeyState); 16 | If CurrentState = 0 then 17 | begin 18 | KeyState[vk_numlock] := 1; 19 | SetKeyboardState(KeyState); 20 | end; 21 | end; 22 |  -------------------------------------------------------------------------------- /dos/0057.pas: -------------------------------------------------------------------------------- 1 | 2 | procedure ColdBoot; assembler; 3 | asm 4 | xor ax,ax 5 | mov ds,ax 6 | mov ah,$40 7 | mov es,ax 8 | mov word ptr es:$72,0 9 | mov ax,$FFFF 10 | mov es,ax 11 | xor si,si 12 | push ax 13 | push si 14 | retf 15 | end; 16 | 17 | procedure WarmBoot; assembler; 18 | asm 19 | xor ax,ax 20 | mov ds,ax 21 | mov ah,$40 22 | mov es,ax 23 | mov word ptr es:$72,$1234 24 | mov ax,$FFFF 25 | mov es,ax 26 | xor si,si 27 | push ax 28 | push si 29 | retf 30 | end; 31 | 32 |  -------------------------------------------------------------------------------- /joystick/0004.pas: -------------------------------------------------------------------------------- 1 | 2 | Anyone know how to read the Joystick.... 3 | 4 | if you are using an AT (286 or later), here's the easy way. 5 | Use Intr ($15, Regs), and load AH With the $84, then load 6 | DX With 1 to get the joystick status' and 0 to get the 7 | button status. if you use DX=1, it returns: 8 | 9 | AX x of joystick A 10 | BX y of joystick A 11 | CX x of joystick B 12 | DX y of joystick B 13 | 14 | if you use DX=0: 15 | 16 | AL button status, bit # 17 | 4 joystick A,button 1 18 | 5 joystick A,button 2 19 | 6 joystick B,button 1 20 | 7 joystick B,button 2 21 |  -------------------------------------------------------------------------------- /delphi/0241.pas: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- 4 | In Delphi, color is often represented using the TColor object. In HTML 5 | documents, color is usually represented using a 6 character hex string. 6 | Following function will convert TColor type color values to hex strings: 7 | 8 | function 9 | GetColorHexStr( Color : TColor ) 10 | : string; 11 | begin 12 | Result := 13 | IntToHex( GetRValue( Color ), 2 ) + 14 | IntToHex( GetGValue( Color ), 2 ) + 15 | IntToHex( GetBValue( Color ), 2 ); 16 | end; 17 | 18 | 19 |  -------------------------------------------------------------------------------- /delphi/0380.pas: -------------------------------------------------------------------------------- 1 | >Can I prevent any screensaver to kick in as long as my application is 2 | >running ? 3 | 4 | 5 | Hi Lee, 6 | 7 | Try the following: 8 | 9 | Assign the following handler to Application.OnMessage: 10 | 11 | procedure AppMessage(var Msg: TMsg; var Handled: Boolean); 12 | begin 13 | if Msg.Message = WM_SYSCOMMAND then 14 | if (Msg.wParam = SC_SCREENSAVE) or (Msg.wParam = SC_MONITORPOWER) then 15 | Handled := true; // prevent screensaver 16 | end; 17 | 18 | This will prevent starting screensaver or monitor power saving. 19 | 20 | Regards, 21 | 22 | Ahto 23 |  -------------------------------------------------------------------------------- /graphics/0214.pas: -------------------------------------------------------------------------------- 1 | Uses Crt,Newgraph; 2 | { NOTE : NewGraph - in GRAPHICS.SWG } 3 | 4 | 5 | Var ImgPointer: pointer; 6 | 7 | FUNCTION IntToStr(Value : LONGINT) : STRING; 8 | VAR 9 | Stg : STRING; 10 | BEGIN 11 | STR (value : 13, Stg); 12 | IntToStr := Stg; 13 | END; 14 | 15 | Begin 16 | LoadShape(ParamStr(1),ImgPointer); 17 | InitVGAMode; 18 | Blit(0,0,ImgPointer^); 19 | OutTextXY(0,190,IntToStr(ShapeWidth(ImgPointer^))); 20 | OutTextXY(20,190,IntToStr(ShapeHeight(ImgPointer^))); 21 | Repeat Until keypressed; 22 | End. -------------------------------------------------------------------------------- /mouse/0035.pas: -------------------------------------------------------------------------------- 1 | {I need a code snippet that will test to determine whether a mouse driver is loaded. } 2 | 3 | FUNCTION DriverInstalled : boolean; {this checks for a mouse driver!} 4 | CONST 5 | iret = 207; 6 | VAR 7 | driverOff, driverSeg : Integer; 8 | Begin 9 | driverOff := MemW[0000:0204]; 10 | driverSeg := MemW[0000:0206]; 11 | IF ((driverSeg <> 0) and (driverOff <> 0)) THEN 12 | Begin 13 | IF (Mem [driverSeg:driverOff] <> iret) THEN DriverInstalled := true 14 | ELSE DriverInstalled := false 15 | End 16 | ELSE DriverInstalled := false 17 | End; 18 |  -------------------------------------------------------------------------------- /isr/dir.txt: -------------------------------------------------------------------------------- 1 | SWAG Title: ISR HANDLING ROUTINES 2 | 0001.PAS 05-28-93 13:49 "CLOCK.PAS" by SWAG SUPPORT TEAM 3 | 0002.PAS 05-28-93 13:49 "DELAYHK.PAS" by SWAG SUPPORT TEAM 4 | 0003.PAS 05-28-93 13:49 "ISRDEMO.PAS" by SWAG SUPPORT TEAM 5 | 0004.PAS 05-28-93 13:49 "ISRDEMO1.PAS" by SWAG SUPPORT TEAM 6 | 0005.PAS 05-28-93 13:49 "ISRINFO.PAS" by SWAG SUPPORT TEAM 7 | 0006.PAS 05-28-93 13:49 "MYCHECK.PAS" by SWAG SUPPORT TEAM 8 | 0007.PAS 05-28-93 13:49 "RUNINBCK.PAS" by SWAG SUPPORT TEAM 9 | 0008.PAS 05-28-93 13:49 "WATCHDOG.PAS" by SWAG SUPPORT TEAM 10 | -------------------------------------------------------------------------------- /sound/0008.pas: -------------------------------------------------------------------------------- 1 | {$M 16384,0,0} 2 | 3 | Program Demo; { to demonstrate the SBVoice Unit } 4 | { Copyright 1991 Amit K. Mathur, Windsor, Ontario } 5 | 6 | Uses SBVoice; 7 | 8 | begin 9 | if SBFound then begin 10 | if paramcount=1 then begin 11 | LoadVoice(ParamStr(1),0,0); 12 | sb_Output(seg(SoundFile),ofs(SoundFile)+26); 13 | Repeat 14 | Write('Ha'); 15 | Until StatusWord=0; 16 | end else 17 | Writeln('Usage: DEMO [d:\path\]Filename.voc'); 18 | end else 19 | Writeln('SoundBlaster Init Error. SoundBlaster v1.00 not Found.'); 20 | end. 21 | 22 |  -------------------------------------------------------------------------------- /dos/0003.pas: -------------------------------------------------------------------------------- 1 | Procedure Warm_Boot; 2 | Begin 3 | Inline($BB/$00/$01/$B8/$40/$00/$8E/$D8/ 4 | $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF); 5 | End; 6 | 7 | Procedure Cold_Boot; 8 | Begin 9 | Inline($BB/$38/$12/$B8/$40/$00/$8E/$D8/ 10 | $89/$1E/$72/$00/$EA/$00/$00/$FF/$FF); 11 | End; 12 | 13 | I saw that you were posting reboot procedures...I didn't catch what it was for 14 | though, but maybe these will help. 15 | 16 | 17 | --- XANADU (1:124/7007) 18 | * Origin: * XANADU * Grand Prairie, TX * (1:124/7007) 19 |  -------------------------------------------------------------------------------- /egavga/0220.pas: -------------------------------------------------------------------------------- 1 | { 2 | Code, without interrupts to display a pixel in mode 101h (640**480**256) 3 | using direct writes. Jort Bloem helped some, but his page routine is to 4 | slow. If not the entire procedure then please, just the following code 5 | with direct, as fast as possible, access vga memory writes.} 6 | {donated by Jort Bloem, updated in asm by me} 7 | 8 | Procedure Page (p : byte); 9 | begin 10 | if lastpage = p then exit; 11 | lastpage := p; 12 | asm 13 | mov ax, 4f05h; 14 | mov bx, 0000h; 15 | mov dx, p; 16 | int 10h; 17 | end; 18 | end; 19 |  -------------------------------------------------------------------------------- /math/0037.pas: -------------------------------------------------------------------------------- 1 | { 2 | ROBERT ROTHENBURG 3 | 4 | > Can you compute complex numbers and/or "i" in Pascal...if so, how. 5 | 6 | Not too hard. I've done that With some fractal Programs, which were 7 | written For TP5 (it might be easier using OOP With the later versions). 8 | 9 | I use two Variables For a complex number of a+bi, usually expressed as 10 | xa and xb (or x.a and x.b as a Record). 11 | 12 | For addition/subtraction (complex z=x+y): 13 | 14 | z.a:=x.a+y.a; 15 | z.b:=x.b+y.b; 16 | 17 | For multiplication: 18 | 19 | z.a:=(x.a*y.a)-(x.b*y.b); 20 | z.b:=(x.a*y.b)+(x.b*y.a); 21 | } 22 |  -------------------------------------------------------------------------------- /misc/0151.pas: -------------------------------------------------------------------------------- 1 | { 2 | According to a message I just saw on Usenet, many Pentiums have a bug in 3 | their implementation of the FDIV (floating point divide) instruction. 4 | Supposedly the following program prints the value 256.0000, rather than 5 | 0.0000, on one of these: 6 | } 7 | {$N+,E-} 8 | program pentbug; 9 | var 10 | x,y,z : double; 11 | begin 12 | x := 4195835; 13 | y := 3145727; 14 | z := x - (x/y)*y; 15 | writeln('z=',z:0:4,' (should be 0.0000)'); 16 | end. 17 | 18 | { 19 | Does anyone out there have a Pentium to try this on? It prints 0.0000 on my 20 | 486DX. 21 | } 22 |  -------------------------------------------------------------------------------- /textedit/0001.pas: -------------------------------------------------------------------------------- 1 | { 2 | >Anyways, does anyone here have a quick and easy Procedure or 3 | >Function For centering Text? 4 | } 5 | 6 | Program CenterIt_Demo; 7 | 8 | Uses 9 | Crt; 10 | 11 | { Display a String centered on the screen. } 12 | Procedure DisplayCenter(st_Temp : String; by_Yaxis : Byte); 13 | begin 14 | GotoXY(((Succ(Lo(WindMax)) - Length(st_Temp)) div 2), by_Yaxis); 15 | Writeln(st_Temp); 16 | end; {DisplayCenter. } 17 | 18 | Var 19 | by_OldAttr : Byte; 20 | 21 | begin 22 | ClrScr; 23 | DisplayCenter('The Spirit of Elvis says... Hi!', 10); 24 | ReadKey; 25 | end. 26 |  -------------------------------------------------------------------------------- /crt/0006.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Could someone please post an Asm equivalent of 3 | > Repeat Until KeyPressed; 4 | 5 | Well, here it is using the Dos Unit instead of the Crt.... :) 6 | } 7 | Uses Dos; 8 | Var 9 | r : Registers; 10 | 11 | Function _ReadKey : Char; 12 | begin 13 | r.ax := $0700; 14 | intr($21, r); 15 | _ReadKey := chr(r.al); 16 | end; 17 | 18 | Function _KeyPressed : Boolean; 19 | begin 20 | r.ax := $0b00; 21 | intr($21,r); 22 | if r.al = 255 then 23 | _KeyPressed := True 24 | else 25 | _KeyPressed := False; 26 | end; 27 | begin 28 | Repeat Until _keypressed; 29 | end. -------------------------------------------------------------------------------- /mouse/0037.pas: -------------------------------------------------------------------------------- 1 | {I need a code snippet that will test to determine whether a mouse driver 2 | is loaded. } 3 | 4 | 5 | FUNCTION DriverInstalled : boolean; {this checks for a mouse driver!} 6 | CONST 7 | iret = 207; 8 | VAR 9 | driverOff, driverSeg : Integer; 10 | Begin 11 | driverOff := MemW[0000:0204]; 12 | driverSeg := MemW[0000:0206]; 13 | IF ((driverSeg <> 0) and (driverOff <> 0)) THEN 14 | Begin 15 | IF (Mem [driverSeg:driverOff] <> iret) THEN DriverInstalled := true 16 | ELSE DriverInstalled := false 17 | End 18 | ELSE DriverInstalled := false 19 | End; 20 | 21 |  -------------------------------------------------------------------------------- /pointers/0024.pas: -------------------------------------------------------------------------------- 1 | { 2 | CC> I want to know how to retrieve the n(th) element from the 3 | CC> table in BASM. 4 | 5 | Solution: 6 | } 7 | 8 | program _getvalue; 9 | 10 | const table:array[0..9] of integer= 11 | (1001,1002,1003,1004,1005,1006,1007,1008,1009,1010); 12 | 13 | function getvalue(nth:word):integer; assembler; 14 | asm 15 | mov si,nth { get index } 16 | add si,si { 'multiply' by two (word-sized) } 17 | mov ax,word ptr table[si] { put table[index] in ax -> function-result } 18 | end; 19 | 20 | begin 21 | writeln(getvalue(7)); 22 | end. 23 |  -------------------------------------------------------------------------------- /strings/0002.pas: -------------------------------------------------------------------------------- 1 | Procedure CleanString(Var s:String); 2 | begin 3 | fillChar(s,sizeof(s),0); 4 | end; 5 | { I think that I already posted this form once, but here it is again... 6 | This is the best way, For what the original poster wanted it for- to 7 | clear out a String to Write to a File. Method #1 above will overfill 8 | any subranged String, yours only clears out the current size of the 9 | String (ie if you had s:String; s := 'a'; then your Procedure would 10 | only fill the first Character. The last version merely fills the 11 | entire String no matter what the size of it is. 12 | -Brian Pape 13 | } -------------------------------------------------------------------------------- /timing/0004.pas: -------------------------------------------------------------------------------- 1 | {$A+,B-,D-,E-,F-,I-,N-,O-,R-,S-,V-} 2 | 3 | Program TimeNullRoutine; 4 | 5 | Uses 6 | TpTimer; 7 | 8 | Var 9 | Count : Byte; 10 | 11 | Procedure DoNothing; 12 | begin 13 | end; 14 | 15 | Var 16 | Loop : Word; 17 | Start, 18 | Stop : LongInt; 19 | 20 | begin 21 | Start := ReadTimer; 22 | For Loop := 1 to 1000 do 23 | DoNothing; 24 | Stop := ReadTimer; 25 | WriteLn('Time = ', ElapsedTimeString(Start, Stop), ' ms') 26 | end. 27 | 28 | { 29 | ...Well running the Program listed above, 1000 nul loops time 30 | in at 3.007 miliseconds on my 386SX-25. 31 | } -------------------------------------------------------------------------------- /color/0008.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I have seen a lot of applications that use highintensity background 3 | > colors in Text mode. How do they do it?????? 4 | } 5 | 6 | Uses Crt ; 7 | 8 | Procedure DisableHiBackGround(SetHi : Boolean); Assembler; 9 | Asm 10 | Mov AX, $1003 11 | Mov BL, SetHi 12 | Int $10 13 | end ; 14 | 15 | begin 16 | ClrScr; 17 | TextAttr := White + (LightRed ShL 4); 18 | DisableHiBackGround(True) ; 19 | Write('Blinking...[Enter]') ; 20 | ReadLn ; 21 | DisableHiBackGround(False) ; 22 | Write(' WOW !!! ') ; 23 | ReadLn ; 24 | end. 25 |  -------------------------------------------------------------------------------- /egavga/0132.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I found this code in SWAG at EGAVGA.SWG category however It 3 | > doesn't switch my screen in 28 lines mode. 4 | 5 | That's because all values must be hex. Add a 'h' to all numbers, and it should 6 | be fine. Or try this: 7 | } 8 | program test28rows; 9 | 10 | procedure switch28; assembler; 11 | asm 12 | mov ax,1202h { set up 400 scan lines } 13 | mov bl,30h 14 | int 10h 15 | mov ax,0003h { set up normal text mode } 16 | int 10h 17 | mov ax,1111h { load ega character set } 18 | mov bl,00h 19 | int 10h 20 | END; 21 | 22 | begin 23 | switch28; 24 | end. 25 |  -------------------------------------------------------------------------------- /textfile/0006.pas: -------------------------------------------------------------------------------- 1 | {--PTYPES.INC----------------------------------------------------------- 2 | } 3 | { Type and Constant decalarations } 4 | 5 | CONST 6 | MAX_FILENAME_LEN = 32; 7 | MAX_SOURCELINE_LEN = 246; 8 | MAX_PRINTLINE_LEN = 80; 9 | MAX_LINES_PER_PAGE = 50; 10 | DATE_STRING_LENGTH = 26; 11 | F_FEED = #12; 12 | 13 | VAR 14 | line_num, page_num, 15 | level, line_count :word; 16 | 17 | source_buffer :string[MAX_SOURCELINE_LEN]; 18 | source_name :string[MAX_FILENAME_LEN]; 19 | date :string[DATE_STRING_LENGTH]; 20 | F1 :text; 21 | 22 |  -------------------------------------------------------------------------------- /memory/0028.pas: -------------------------------------------------------------------------------- 1 | Uses 2 | Dos; 3 | 4 | Var 5 | HaveMem : Boolean; 6 | 7 | procedure check_xms(VAR installed : boolean); 8 | Var 9 | regs : registers; 10 | begin 11 | regs.ax := $4300; 12 | intr($2F, regs); 13 | installed := regs.al = $80; 14 | end; 15 | 16 | procedure check_ems(VAR installed : boolean); 17 | var 18 | regs : registers; 19 | begin 20 | regs.ah := $46; 21 | intr($67, regs); 22 | installed := regs.ah = $00; 23 | end; 24 | 25 | begin 26 | check_xms(HaveMem); 27 | writeln('XMS: ',HaveMem); 28 | check_ems(HaveMem); 29 | writeln('EMS: ',HaveMem); 30 | end. 31 | 32 |  -------------------------------------------------------------------------------- /crt/0012.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... SetBlink; 3 | * Purpose ....... To enable blinking vice intensity 4 | * Parameters .... None 5 | * Returns ....... Nothing 6 | * Notes ......... Colors with the background attribute high-bit set will 7 | * blink. 8 | * Author ........ Martin Richardson 9 | * Date .......... October 28, 1992 10 | ****************************************************************************} 11 | PROCEDURE SetBlink; ASSEMBLER; 12 | ASM 13 | MOV AX, 1003h 14 | MOV BL, 01h 15 | INT 10h 16 | END; 17 |  -------------------------------------------------------------------------------- /delphi/0436.pas: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- 4 | 5 | function InPort(PortAddr: word): byte; 6 | {$IFDEF VER90} 7 | assembler; stdcall; 8 | asm 9 | mov dx,PortAddr 10 | in al,dx 11 | end; 12 | {$ELSE} 13 | begin 14 | Result := Port[PortAddr]; 15 | end; 16 | {$ENDIF} 17 | 18 | procedure OutPort(PortAddr: word; Databyte: byte); 19 | {$IFDEF VER90} 20 | assembler; stdcall; 21 | asm 22 | mov al,Databyte 23 | mov dx,PortAddr 24 | out dx,al 25 | end; 26 | {$ELSE} 27 | begin 28 | Port[PortAddr] := DataByte; 29 | end; 30 | {$ENDIF} 31 |  -------------------------------------------------------------------------------- /drives/0006.pas: -------------------------------------------------------------------------------- 1 | { 2 | Here are some routines For Changing and detecting drives. 3 | } 4 | 5 | Uses Crt, Dos; 6 | Var 7 | Regs :Registers; 8 | 9 | Function GetDrive :Byte; 10 | begin 11 | Regs.AX := $1900; 12 | Intr($21,Regs); 13 | GetDrive := (Regs.AL + 1); 14 | (* Returns 1 = A:, 2 = B:, 3 = C:, Etc *) 15 | end; 16 | 17 | Procedure ChangeDrive(Drive :Byte); 18 | begin 19 | Regs.AH := $0E; 20 | Regs.DL := Drive; (* Drive 1 = A:, 2 = B:, 3 = C: *) 21 | Intr($21,Regs); 22 | end; 23 | 24 | begin 25 | ClrScr; 26 | Writeln(' Current Drive : ',CHR( GetDrive+64 )); 27 | end. 28 |  -------------------------------------------------------------------------------- /numbers/0007.pas: -------------------------------------------------------------------------------- 1 | Type 2 | bsingle = Array [0..3] of Byte; 3 | 4 | { converts Microsoft 4 Bytes single to TP Real } 5 | 6 | Function msb_to_Real (b : bsingle) : Real; 7 | Var 8 | pReal : Real; 9 | r : Array [0..5] of Byte Absolute pReal; 10 | begin 11 | r [0] := b [3]; 12 | r [1] := 0; 13 | r [2] := 0; 14 | move (b [0], r [3], 3); 15 | msb_to_Real := pReal; 16 | end; { Function msb_to_Real } 17 | 18 | { 19 | Another Turbo Pascal routine to convert Microsoft single to TP LongInt 20 | 21 | index := ((mssingle and not $ff000000) or $00800000) shr (24 - 22 | ((mssingle shr 24) and $7f)) - 1; 23 | } 24 |  -------------------------------------------------------------------------------- /numbers/0022.pas: -------------------------------------------------------------------------------- 1 | { 2 | >Is there a way (using bit manipulations such as AND, OR, XOR) to 3 | >swap to Variables without making a 3rd temporary Variable? 4 | > 5 | 6 | If the two Variables are numbers, and the following operations 7 | won't overflow the limitations of the Type, then yes, you can 8 | do it like this: 9 | } 10 | Var 11 | A, B : Integer; 12 | 13 | begin 14 | A := 5; 15 | B := 3; 16 | 17 | A := A + B; 18 | B := A - B; 19 | A := A - B; 20 | 21 | { which is 22 | 23 | A := 5 + 3 (8) 24 | B := 8 - 3 (5) 25 | A := 8 - 5 (3) 26 | 27 | A = 3 28 | B = 5 } 29 | 30 | end; -------------------------------------------------------------------------------- /strings/0085.pas: -------------------------------------------------------------------------------- 1 | { 2 | Thanks but I already wrote a string flipping function, I asked for a 3 | BASM or Assembler function for optimized speed. 4 | } 5 | 6 | function FlipStr(S:string):string; ASSEMBLER; 7 | ASM 8 | les di,@Result 9 | mov dx,ds 10 | lds si,S 11 | xor ax,ax 12 | cld 13 | lodsb 14 | mov [di],al 15 | add di,ax 16 | mov cx,ax 17 | jcxz @Done 18 | @@1: cld 19 | lodsb 20 | std 21 | stosb 22 | loop @@1 23 | mov ds,dx 24 | END; 25 | 26 | 27 |  -------------------------------------------------------------------------------- /math/0004.pas: -------------------------------------------------------------------------------- 1 | { 2 | >The problem is to Write a recursive Program to calculate Fibonacci numbers. 3 | >The rules For the Fibonacci numbers are: 4 | > 5 | > The Nth Fib number is: 6 | > 7 | > 1 if N = 1 or 2 8 | > The sum of the previous two numbers in the series if N > 2 9 | > N must always be > 0. 10 | } 11 | 12 | Function fib(n : LongInt) : LongInt; 13 | begin 14 | if n < 2 then 15 | fib := n 16 | else 17 | fib := fib(n - 1) + fib(n - 2); 18 | end; 19 | 20 | Var 21 | Count : Integer; 22 | 23 | begin 24 | Writeln('Fib: '); 25 | For Count := 1 to 15 do 26 | Write(Fib(Count),', '); 27 | end. -------------------------------------------------------------------------------- /datatype/0017.pas: -------------------------------------------------------------------------------- 1 | { 2 | To shift a LongInt or Pointer into another Word do this.. 3 | 4 | The HoBitsToShift is the number of Bits you want to move 5 | the way i did it you get the upper half of the LongInt first... 6 | } 7 | 8 | Function Shitftit(Var MyLongInt : LongInt) : Word; 9 | Var 10 | Count : Byte; 11 | TShift : Word; 12 | Begin 13 | TShift := 0; 14 | For Count := 1 to HowBitsToShift Do 15 | Begin 16 | Tshit := (Tshit Shl 1); 17 | If MyLongInt and $80000000 <> 0 Then 18 | TShift := (TShift or $01); 19 | MyLongInt := (MyLongInt Shl 1); 20 | End; 21 | ShiftIt := TShift; 22 | End; 23 | 24 |  -------------------------------------------------------------------------------- /delphi/0008.pas: -------------------------------------------------------------------------------- 1 | {This is an equivalent to the Delay procedure in Borland Pascal. You may 2 | find it of interest. It is not mine. It was given to me by someone else 3 | who did not cite the source. Hope it helps your important WWW page. Take 4 | care. 5 | } 6 | 7 | procedure TForm1.Delay(msecs:integer); 8 | var 9 | FirstTickCount:longint; 10 | begin 11 | FirstTickCount:=GetTickCount; 12 | repeat 13 | Application.ProcessMessages; {allowing access to other 14 | controls, etc.} 15 | until ((GetTickCount-FirstTickCount) >= Longint(msecs)); 16 | end; 17 | 18 | 19 |  -------------------------------------------------------------------------------- /delphi/0053.pas: -------------------------------------------------------------------------------- 1 | 2 | {I saw someone asking how to get DOS environment variables from Delphi. 3 | The little Project attached shows how to list all the Environment 4 | variables quite simply.} 5 | 6 | program Getenv; 7 | 8 | uses WinCrt, 9 | WinProcs; 10 | var 11 | ptr: PChar; 12 | Done: BOOLEAN; 13 | begin 14 | ptr := GetDOSEnvironment; 15 | Done := FALSE; 16 | WHILE NOT Done DO 17 | BEGIN 18 | IF ptr^ = #0 THEN 19 | BEGIN 20 | Writeln; 21 | INC(ptr); 22 | IF ptr^ = #0 THEN Done := TRUE 23 | ELSE Write(ptr^); 24 | END 25 | ELSE Write(ptr^); 26 | INC(ptr); 27 | END; 28 | end. 29 | 30 | 31 |  -------------------------------------------------------------------------------- /delphi/0155.pas: -------------------------------------------------------------------------------- 1 | 2 | { 3 | -Does anybody know how I can supress the BEEP in a TEdit component while 4 | -pressing the RETURN key? 5 | 6 | Trap the key in the TEdit's OnKeyPress handler. 7 | Here's the sort of thing I've been using to make the 8 | key behave like the key in a TEdit... 9 | } 10 | 11 | procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); 12 | BEGIN 13 | if (Key = #13) then {= gotcha! =} 14 | BEGIN 15 | Key := #0; {= kill the beep =} 16 | PostMessage(Handle, WM_NEXTDLGCTL, 0, 0); {= move to next tab stop =} 17 | END; 18 | END; 19 | 20 |  -------------------------------------------------------------------------------- /memory/0104.pas: -------------------------------------------------------------------------------- 1 | 2 | unit DOSMem; (* By Mitch Davis *) 3 | 4 | interface 5 | 6 | function Alloc (paras:word):word; 7 | procedure Free (p:word); 8 | function Largest:word; 9 | 10 | implementation 11 | 12 | function Alloc; assembler; 13 | asm 14 | mov ah, $48 15 | mov bx, paras 16 | int $21 17 | jnc @1 18 | xor ax, ax 19 | @1: 20 | end; 21 | 22 | procedure Free; assembler; 23 | asm 24 | mov ah, $49 25 | mov es, p 26 | int $21 27 | end; 28 | 29 | function Largest; assembler; 30 | asm 31 | mov ah, $48 32 | mov bx, -1 33 | int $21 34 | mov ax, bx 35 | end; 36 | 37 | end. 38 |  -------------------------------------------------------------------------------- /misc/0040.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... RND() 3 | * Purpose ....... To generate a random number 4 | * Parameters .... i Max value for number range 5 | * Returns ....... A random number between 1 and i 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | { FUNCTION to generate a random number between 1 and i } 11 | FUNCTION RND( i: LONGINT ): LONGINT; 12 | BEGIN 13 | RND := RANDOM( i ) + 1; 14 | END; 15 | 16 |  -------------------------------------------------------------------------------- /color/0011.pas: -------------------------------------------------------------------------------- 1 | { 2 | > How would I implement the high intensity colors For the TextBACKGROUND 3 | > Procedure in the Crt Unit? 4 | } 5 | 6 | Procedure LightEGAVGA(TurnOn : Boolean); 7 | Var Regs : Registers; 8 | begin 9 | Regs.AH := $10; 10 | Regs.AL := $03; 11 | Regs.BL := Byte(TurnOn); 12 | Int($10,Regs); 13 | end; 14 | 15 | Procedure LightHGC(TurnOn : Boolean); 16 | begin 17 | if TurnOn then Port[$3b8] := $29 18 | else Port[$3b8] := $09; 19 | end; 20 | 21 | Procedure LightCGA(TurnOn : Boolean); 22 | begin 23 | if TurnOn then Port[$3d8] := $29 24 | else Port[$3d8] := $09; 25 | end; 26 | 27 |  -------------------------------------------------------------------------------- /crt/0020.pas: -------------------------------------------------------------------------------- 1 | 2 | { 3 | Does anyone have a routine, or more, that will change video mode, 25 4 | to 43/50 lines, or back WITHOUT clearing the screen as TextMode does? 5 | I "hate" that , I know OpCrt is supposed to do that, but I cannot 6 | use OpCrt in this program without doing MAJOR changes to about 20 7 | other units that use Tp.Crt. I will, but later, fix that, but for now 8 | could use a routine of this nature.... } 9 | 10 | 11 | PROCEDURE SwitchTo43&50; ASSEMBLER; 12 | ASM 13 | MOV AX,$1112 14 | INT $10 15 | END; 16 | 17 | PROCEDURE SwitchTo25; ASSEMBLER; 18 | ASM 19 | MOV AX,$1114 20 | INT $10 21 | END; 22 |  -------------------------------------------------------------------------------- /delphi/0015.pas: -------------------------------------------------------------------------------- 1 | 2 | iconized apps 3 | 4 | Q: How do I keep the form in icon form when I run it? 5 | 6 | A: 7 | 8 | 1. You must set WindowState to wsMinimized in the form's properties. 9 | 10 | 2. In the private section of the form object's declaration, put: 11 | 12 | PROCEDURE WMQueryOpen(VAR Msg : TWMQueryOpen); message WM_QUERYOPEN; 13 | 14 | 3. In the implementation section, put this method: 15 | 16 | PROCEDURE TForm1.WMQueryOpen(VAR Msg : TWMQueryOpen); 17 | begin 18 | Msg.Result := 0; 19 | end; 20 | 21 | That's it! The form will always remain iconic. 22 | 23 | 24 | 25 | 26 |  -------------------------------------------------------------------------------- /network/0017.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Is there a way to detect if a system is running under Novell Netware? 3 | > There must be an interrupt to do that, but wich one? 4 | } 5 | 6 | Uses 7 | Dos; 8 | 9 | Function stationno : byte; 10 | var 11 | B : byte; 12 | Regs : Registers; 13 | begin 14 | With Regs do 15 | begin 16 | ah := $DC; 17 | ds := 0; 18 | si := 0; 19 | end; 20 | MsDos( Regs ); {INT $21,ah=dh} 21 | b := Regs.al; 22 | stationno := b; 23 | end; 24 | 25 | { Should return 0 if not attached to a novell server otherwise 26 | workstation number } 27 | 28 | begin 29 | Writeln(StationNo); 30 | end. 31 |  -------------------------------------------------------------------------------- /strings/0001.pas: -------------------------------------------------------------------------------- 1 | Function Asc2Str(Var s; Max : Byte): String; 2 | { Converts an ASCIIZ String to a Turbo Pascal String } 3 | { With a maximum length of max. } 4 | Var 5 | StArray : Array[1..255] of Char Absolute s; 6 | Len : Integer; 7 | begin 8 | Len := Pos(#0,StArray)-1; { Get the length } 9 | if (Len > Max) or (Len < 0) then { length exceeds maximum } 10 | Len := Max; { so set to maximum } 11 | Asc2Str := StArray; 12 | Asc2Str[0] := Chr(Len); { Set length } 13 | end; { Asc2Str } 14 |  -------------------------------------------------------------------------------- /strings/0131.pas: -------------------------------------------------------------------------------- 1 | 2 | This function will add commas to a longint. 3 | 4 | function FormatNumber(l: longint): string; 5 | var 6 | len, count: integer; 7 | s: string; 8 | begin 9 | str(l, s); 10 | len := length(s); 11 | for count := ((len - 1) div 3) downto 1 do 12 | begin 13 | insert(',', s, len - (count * 3) + 1); 14 | len := len + 1; 15 | end; 16 | FormatNumber := s; 17 | end; 18 | 19 | And if you are using Delphi, there is, of course, the easy way: 20 | 21 | function FormatNumber(l: longint): string; 22 | begin 23 | FormatNumber := FormatFloat('#,##0', StrToFloat(IntToStr(l))); 24 | end; 25 | 26 |  -------------------------------------------------------------------------------- /graphics/0055.pas: -------------------------------------------------------------------------------- 1 | { 2 | > does anyone know how to scroll up or down in 320*200*256 mode ?? 3 | 4 | Enter mode-x (look for source on any board, quite common), and 5 | then pan the screen like this: 6 | } 7 | 8 | Asm 9 | mov bx,StartMem 10 | mov ah,bh 11 | mov al,0ch 12 | mov dx,3d4h 13 | out dx,ax 14 | mov ah,bl 15 | inc al 16 | out dx,ax 17 | End; 18 | { 19 | To begin, zero StartMem and then increase it with 80 each time - 20 | tada - the screen pans down. Oh, btw, If I were you I would call 21 | a sync just before running it... 22 | } -------------------------------------------------------------------------------- /graphics/0232.pas: -------------------------------------------------------------------------------- 1 | 2 | procedure load_icon(xx,yy :integer;iconname :string); 3 | 4 | var 5 | r,rr :byte; 6 | f :text; 7 | 8 | begin 9 | x :=xx;y :=yy; 10 | assign(f,iconname +'.ico'); 11 | {$I-} reset(f); {$I+} 12 | if ioresult =0 then begin 13 | for p :=1 to 766 do begin 14 | read(f,ch);q :=ord(ch); 15 | if (p >126) and (p <639) then begin 16 | r :=q shr 4;rr :=q-r div 16; 17 | putpixel(x,y,r);putpixel(x+1,y,rr); 18 | inc(x,2); 19 | if x =xx+32 then begin 20 | x :=xx;dec(y); 21 | end; 22 | end; 23 | end; 24 | close(f); 25 | end; 26 | end; 27 |  -------------------------------------------------------------------------------- /color/0001.pas: -------------------------------------------------------------------------------- 1 | { 2 | >Hello, I am writing an application that is some what color 3 | >coordinated. I would like to have the background changed (usually 4 | >black) to one of the background colors without affecting the 5 | >foreground (so I do not have to reWrite the foreground screen). So 6 | } 7 | 8 | Uses 9 | Dos; 10 | 11 | Procedure ChangeBG(Color : Byte); 12 | Var i : Word; 13 | begin 14 | For i := 0 to 3999 do 15 | If Odd(i) then 16 | Mem[$b800:i] := (Mem[$b800:i] and 15) or ((Color and 7) shl 4) 17 | end; 18 | 19 | Var 20 | ColChar : String; 21 | begin 22 | ColChar := ParamStr(1); 23 | ChangeBg(Ord(ColChar[1])); 24 | end. -------------------------------------------------------------------------------- /comm/0080.pas: -------------------------------------------------------------------------------- 1 | { 2 | > how do I detect a 'RING' signal from the modem at COMx? (I want to 3 | > write a tsr that makes the monitor flash red (like fading color 0 from 4 | > black to red and back - that would be no problem, but the TSR and the 5 | > modem part sure is) 6 | 7 | Sure, here's how you can do it without monitoring the actual output 8 | of the modem, and would definetaly be the best way to do it with a TSR. 9 | } 10 | 11 | Const 12 | MSR = $06; 13 | 14 | Function Ringing(cb: word): boolean; 15 | begin 16 | ringing := port[cb+MSR] and $40 = $40; 17 | end; 18 | 19 | begin 20 | cb := $3F8; 21 | writeln(ringing(cb)); 22 | end. 23 |  -------------------------------------------------------------------------------- /misc/0042.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... STOI() 3 | * Purpose ....... To convert a string to an integer 4 | * Parameters .... cNum String to convert to integer format 5 | * Returns ....... cNum as a numeric integer 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | FUNCTION STOI( cNum: STRING ): LONGINT; 11 | VAR 12 | c: INTEGER; 13 | i: LONGINT; 14 | BEGIN 15 | VAL( cNum, i, c ); 16 | STOI := i; 17 | END; 18 | 19 |  -------------------------------------------------------------------------------- /oop/0065.pas: -------------------------------------------------------------------------------- 1 | { 2 | Tried to use the "Popup menu" in turbo vision ? 3 | Is it documented how to do it ? 4 | Well anyway if you do you'll find it doesn't release the memory used by its 5 | topics - don't know if this is a "known" bug ? 6 | 7 | Here is an inherited unit to use in addition to the menus unit: 8 | } 9 | 10 | unit pelmenus; 11 | interface 12 | uses menus; 13 | 14 | type 15 | PpelMenuPopup=^TpelMenuPopup; 16 | TpelMenuPopup=object(TMenuPopup) 17 | destructor done;virtual; 18 | end; 19 | implementation 20 | 21 | destructor TpelMenuPopup.Done; 22 | begin 23 | TMenuView.Done; 24 | DisposeMenu(Menu); 25 | end; 26 | end. 27 |  -------------------------------------------------------------------------------- /crt/0013.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... SetBright; 3 | * Purpose ....... To enable intensity vice blinking 4 | * Parameters .... None 5 | * Returns ....... Nothing 6 | * Notes ......... Colors with the background attribute high-bit set will 7 | * show the background in bright colors. 8 | * Author ........ Martin Richardson 9 | * Date .......... October 28, 1992 10 | ****************************************************************************} 11 | PROCEDURE SetBright; ASSEMBLER; 12 | ASM 13 | MOV AX, 1003h 14 | XOR BL, BL 15 | INT 10h 16 | END; 17 | 18 |  -------------------------------------------------------------------------------- /hardware/0043.pas: -------------------------------------------------------------------------------- 1 | 2 | (* Program name, SPEED. Toggles the fast/slow turbo mode on most 3 | 386/486 mother boards with an AMI BIOS. *) 4 | 5 | uses DOS; 6 | var 7 | reg : registers; 8 | 9 | begin 10 | 11 | if ParamCount = 0 then 12 | writeln(#13,#10,'"SPEED +" toggles turbo to fast, "SPEED -" toggles turbo to slow '); 13 | 14 | if ParamStr(1) = '+' then 15 | begin 16 | reg.ah := $F0; 17 | reg.al := $02; 18 | intr($16,reg); 19 | end; {Set turbo mode to fast} 20 | 21 | if ParamStr(1) = '-'then 22 | begin 23 | reg.ah := $F0; 24 | reg.al := $01; 25 | intr($16,reg); 26 | end; {Set turbo node to slow} 27 | end. 28 |  -------------------------------------------------------------------------------- /cursor/0013.pas: -------------------------------------------------------------------------------- 1 | { 2 | SEAN PALMER 3 | 4 | This is an example for the cursor I talked about to someone on here... 5 | } 6 | 7 | program spinCursor; 8 | 9 | uses 10 | crt; 11 | 12 | var 13 | cursorState : byte; {0..3} 14 | i : integer; 15 | 16 | const 17 | cursorData : array [0..3] of char = (#30, #17, #31, #16); 18 | 19 | procedure updateCursor; 20 | begin 21 | cursorState := succ(cursorState) and 3; 22 | write(cursorData[cursorState], ^H); 23 | end; 24 | 25 | begin 26 | for i := 1 to 100 do 27 | begin 28 | gotoxy(1,1); 29 | updateCursor; 30 | gotoxy(1,41); 31 | delay(100); 32 | end; 33 | end. 34 |  -------------------------------------------------------------------------------- /delphi/0226.pas: -------------------------------------------------------------------------------- 1 | 2 | procedure AddSourceToRegistry; 3 | 4 | var 5 | NTReg : TRegIniFile; 6 | dwData : DWord; 7 | begin 8 | NTReg := TRegIniFile.Create(''); 9 | try 10 | NTReg.RootKey := HKEY_LOCAL_MACHINE; 11 | NTReg.OpenKey('SYSTEM\CurrentControlSet\Services\EventLog\Application\MyLog',true); 12 | NTReg.LazyWrite := false; 13 | TRegistry(NTReg).WriteString('EventMessageFile',Application.ExeName); 14 | dwData := EVENTLOG_ERROR_TYPE or EVENTLOG_WARNING_TYPE or 15 | EVENTLOG_INFORMATION_TYPE; 16 | TRegistry(NTReg).WriteInteger('TypesSupported', dwData); 17 | 18 | finally 19 | NTReg.Free; 20 | end; 21 | end; 22 |  -------------------------------------------------------------------------------- /drives/0016.pas: -------------------------------------------------------------------------------- 1 | Program TrueName; uses DOS; 2 | 3 | function RealName(FakeName:String):String; 4 | Var Temp:String; 5 | begin 6 | FakeName := FakeName + #0; { ASCIIZ } 7 | With Regs do 8 | begin 9 | AH := $60; 10 | DS := Seg(FakeName); SI := Ofs(FakeName[1]); 11 | ES := Seg(Temp); DI := OfS(Temp[1]); 12 | INTR($21,Regs); 13 | DOSERROR := AX * ((Flags And FCarry) shr 7); 14 | Temp[0] := #255; 15 | Temp[0] := CHAR(POS(#0,Temp)-1); 16 | end; 17 | If DosError <> 0 then Temp := ''; 18 | RealName := Temp; 19 | end; 20 | 21 | begin writeln( RealName( Paramstr(1) ) end. 22 |  -------------------------------------------------------------------------------- /keyboard/0051.pas: -------------------------------------------------------------------------------- 1 | (*========================================================================== 2 | Date: 08-25-93 (00:32) 3 | From: MARC BIR 4 | Subj: CLEAR KEYBOARD 5 | 6 | Here's a quick way to clear keyboard buffer: 7 | *) 8 | 9 | Procedure ClearKeyBoard; 10 | Begin 11 | ASM CLI End; 12 | MemW[$40:$1A] := MemW[$40:$1C]; 13 | ASM STI End; 14 | End; 15 | 16 | (* 17 | MemW[$40:$1A] = ptr to next char in cyclical kbd buffer 18 | MemW[$40:$1C] = ptr to last char "" 19 | 20 | Incase you haven't had data structures, when the next ptr equals the 21 | last ptr in a cyclical buufer, the buffer is empty. 22 | Hope that helps ( doesn't need CRT ) 23 | 24 |  -------------------------------------------------------------------------------- /sound/0026.pas: -------------------------------------------------------------------------------- 1 | { 2 | JOERGEN DORCH 3 | 4 | About Sounds i Pascal - Here's how I do it: 5 | } 6 | 7 | Function Frequency(Octave, NoteNum : Integer) : Integer; 8 | Const 9 | Silence = 32767; 10 | Var 11 | Oct : Integer; 12 | 13 | Function Power(X, Y : Real) : Real; 14 | begin 15 | Power := Exp(Y * Ln(X)); 16 | end; 17 | 18 | begin 19 | Oct := Octave - 3; 20 | if NoteNum > 0 then 21 | Frequency := Round(440 * Power(2, Oct + ((NoteNum - 10) / 12))) 22 | else 23 | Frequency := Silence; 24 | end; 25 | 26 | { 27 | Where Octave is in the range [0..6] and NoteNum in the range [1..12], 28 | that is C = 1, C# = 2, D = 3 etc. 29 | } -------------------------------------------------------------------------------- /comm/0085.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Hi i am trying to make a thing to use an EMSI handshake.. i 3 | > have almost got it working, but i need a routine to purge all the input 4 | > from the com port. can anyone help me out there? i know i had one but 5 | > can't find anything that will really work anymore ... thanks. 6 | } 7 | 8 | Procedure FlushOutput; assembler; 9 | { Wait for all buffer output to be output :) } 10 | asm 11 | mov AH, $08 12 | mov DX, fosport 13 | Int $14 14 | End; 15 | 16 | Procedure PurgeInput; assembler; 17 | { Purges the input buffer -- Empties it into obilivion! } 18 | asm 19 | mov AH, $0A 20 | mov DX, fosport 21 | Int $14 22 | End; 23 | 24 |  -------------------------------------------------------------------------------- /numbers/0006.pas: -------------------------------------------------------------------------------- 1 | { 2 | SEAN PALMER 3 | } 4 | 5 | Function rolW(b : Word; n : Byte) : Word; Assembler; 6 | Asm 7 | mov ax, b 8 | mov cl, n 9 | rol ax, cl 10 | end; 11 | 12 | Function rolB(b, n : Byte) : Byte; Assembler; 13 | Asm 14 | mov al, b 15 | mov cl, n 16 | rol al, cl 17 | end; 18 | 19 | Function rolW1(b : Word) : Word; Assembler; 20 | Asm 21 | mov ax, b 22 | rol ax, 1 23 | end; 24 | 25 | { These would be better off as Inline Functions, such as... } 26 | 27 | Function IrolW1(b : Word) : Word; 28 | Inline( 29 | $58/ {pop ax} 30 | $D1/$C0); {rol ax,1} 31 | 32 | { because no Function call is generated. } 33 | 34 |  -------------------------------------------------------------------------------- /hardware/0031.pas: -------------------------------------------------------------------------------- 1 | { 2 | I'm looking for a SMALL piece of code which can be used to replace a DELAY 3 | command that will be cpu-intensive, meaning that it will execute more quick 4 | depending upon the type of cpu and clock speed. I know that obviously any 5 | code will exhibit this tendency, but I'm looking for something which do so 6 | a most dramatic fashion (as far as speed goes). It should also be rather 7 | small and not necessarily zeroing in on the presence of an FPU. Any ideas? 8 | } 9 | 10 | Procedure CPUDelay(D: Word); Assembler; 11 | asm 12 | @@1: 13 | mov cx,$FFFF 14 | @@2: 15 | nop 16 | loop @@2 17 | dec[d] 18 | jnz @@1 19 | end; 20 |  -------------------------------------------------------------------------------- /screen/0048.pas: -------------------------------------------------------------------------------- 1 | { 2 | I use alot of line draws and some text on the screen....the lines come out 3 | first and then the text a second or two later....is there a way so that the 4 | whole output comes at once. I tried Setvisualpage and setactivepage but the 5 | the whole output screen is off. 6 | 7 | To Turn On/Off the Screen you may use these procedure 8 | } 9 | Procedure OnScreen; 10 | Begin 11 | Port[$3c4]:=1; 12 | Port[$3c5]:=Screen_AttriBute_Tempolary; 13 | end; 14 | 15 | Procedure OffScreen; 16 | Begin 17 | Port[$3c4]:=1; 18 | Screen_Attribute_Tempolary:=Port[$3c5]; 19 | Port[$3c5]:=Screen_AttriBute_Tempolary or $20; 20 | end; 21 |  -------------------------------------------------------------------------------- /crt/0037.pas: -------------------------------------------------------------------------------- 1 | function getchr (x,y : byte) : char; assembler; 2 | asm 3 | mov ah, 3; 4 | xor bh, bh; 5 | int 10h; 6 | push dx; 7 | mov ah, 2; 8 | mov dl, x; 9 | mov dh, y; 10 | dec dl; {Coordinates are 1 based in TP -- 0 based in asm} 11 | dec dh; 12 | int 10h 13 | mov ah, 8; 14 | int 10h; 15 | mov ah, 2; 16 | pop dx; 17 | int 10h; 18 | end; 19 | 20 | This gets a character from the screen without ultimately affecting 21 | cursor positon (it is saved and restored). It can also be used as: 22 | getchr (wherex, wherey); 23 | to get the character at the current cursor location. 24 | 25 | Mike Phillips 26 | INTERNET: phil4086@utdallas.edu 27 |  -------------------------------------------------------------------------------- /delphi/0296.pas: -------------------------------------------------------------------------------- 1 | 2 | > Has anyone had any luck making GetShortPathName 3 | > to work? It's supposed to convert a long file/path 4 | > name to a DOS 8.3 structure... but it keeps returning 5 | > the same long file name I pass in. 6 | 7 | Try this, it worked for me.... 8 | 9 | function ToShortPath( sPath : string ) : string; 10 | var 11 | iLen : integer; 12 | sShort : string; 13 | szShort : PChar; 14 | begin 15 | iLen := Length( sPath ); 16 | 17 | szShort := StrAlloc( iLen ); 18 | GetShortPathName( PChar(sPath), szShort, iLen ); 19 | 20 | sShort := szShort; 21 | StrDispose( szShort ); 22 | 23 | Result := sShort; 24 | end; 25 |  -------------------------------------------------------------------------------- /delphi/0400.pas: -------------------------------------------------------------------------------- 1 | 2 | How can I extract the logged username from Novell server? 3 | 4 | There is a API function called GetUserName : 5 | 6 | procedure TForm1.Button1Click(Sender: TObject); 7 | var 8 | lpBuffer : PChar; 9 | nSize : DWORD; 10 | begin 11 | GetMem(lpBuffer,nSize); 12 | Try 13 | if GetUserName(lpBuffer,nSize) then 14 | Edit1.Text := StrPas(lpBuffer); 15 | Finally 16 | FreeMem(lpBuffer,nSize); 17 | end; 18 | end; 19 | 20 | Also, an other API WNetGetUser - retrieves the current default user name or 21 | the user name used to establish a network connection. 22 | 23 | See the API Help for more details. 24 |  -------------------------------------------------------------------------------- /keyboard/0092.pas: -------------------------------------------------------------------------------- 1 | 2 | Program StuffKeyboardBuffer; 3 | 4 | Uses Crt,Dos; 5 | 6 | Var 7 | Name : String; 8 | 9 | Procedure Stuffit(DChar:Char); 10 | Begin 11 | asm 12 | mov ah,05h 13 | mov ch,1 14 | mov cl, DChar 15 | int 16h 16 | end; 17 | end; 18 | 19 | Procedure StuffKeyboard(D : String); 20 | Var 21 | l : Integer; 22 | 23 | Begin 24 | for l:=1 to length(d) do 25 | StuffIt(D[l]); 26 | End; 27 | 28 | Begin 29 | Clrscr; 30 | Write('Enter your name : '); 31 | StuffKeyboard('Robbie Flynn'); 32 | Readln(Name); 33 | Writeln('Your name is : ',Name); 34 | End. 35 |  -------------------------------------------------------------------------------- /timing/0036.pas: -------------------------------------------------------------------------------- 1 | { 2 | CC> does anyone have a good and accurate delay routine?? 3 | CC> 4 | CC> the crt one doesn't work accurately when turbo is on, and the int 15h 5 | CC> one doesn't work on xt's..does anyone have one that is NOT bios 6 | CC> dependant.. } 7 | 8 | procedure pause(hs:longint); assembler; 9 | asm 10 | mov es,seg0040 11 | mov si,006ch 12 | mov dx,word ptr es:[si+2] 13 | mov ax,word ptr es:[si] 14 | add ax,word ptr [hs] 15 | adc dx,word ptr [hs+2] 16 | @@1: 17 | mov bx,word ptr es:[si+2] 18 | cmp word ptr es:[si+2],dx 19 | jl @@1 20 | mov cx,word ptr es:[si] 21 | cmp word ptr es:[si],ax 22 | jl @@1 23 | end; 24 | 25 |  -------------------------------------------------------------------------------- /datetime/0018.pas: -------------------------------------------------------------------------------- 1 | { DAVID DRZYZGA } 2 | 3 | Program timetest; 4 | Uses 5 | Dos; 6 | 7 | Function time : String; 8 | Var 9 | reg : Registers; 10 | h, m, s : String[2]; 11 | 12 | Function tch(s : String) : String; 13 | Var 14 | temp : String[2]; 15 | begin 16 | temp := s; 17 | if length(s) < 2 then 18 | tch := '0' + temp 19 | else 20 | tch := temp; 21 | end; 22 | 23 | begin 24 | reg.ax := $2c00; 25 | intr($21, reg); 26 | str(reg.cx shr 8, h); 27 | str(reg.cx mod 256, m); 28 | str(reg.dx shr 8, s); 29 | time := tch(h) + ':' + tch(m) + ':' + tch(s); 30 | end; 31 | 32 | begin 33 | Writeln(time); 34 | end. 35 |  -------------------------------------------------------------------------------- /delphi/0389.pas: -------------------------------------------------------------------------------- 1 | 2 | I'm looking for a function that, with a date as param, would 3 | return the date of the last day of the month, i.e. 4 | 5 | function TForm1.LastDateOfMonth(Dt : TDateTime) : TDateTime; 6 | var 7 | Year,Month,Day : Word; 8 | begin 9 | DecodeDate(Dt,Year,Month,Day); 10 | {Make the date the first day of the next month} 11 | Day := 1; 12 | inc(Month); 13 | if Month = 13 then begin 14 | Month := 1; 15 | inc(Year); 16 | end; 17 | {Covert to TDateTime and minus 1 from it to give you the last day 18 | of the previous month} 19 | Dt := EncodeDate(Year,Month,Day); 20 | Result := Dt -1; 21 | end; 22 |  -------------------------------------------------------------------------------- /dirs/0032.pas: -------------------------------------------------------------------------------- 1 | 2 | uses dos; 3 | procedure ProcessAllFiles(dir : dirstr); 4 | var 5 | d : searchrec; 6 | 7 | begin 8 | while (dir[length(dir)] = '\') do dec(dir[0]); 9 | 10 | { this gets the files } 11 | findfirst(dir+'\*.*',anyfile+hidden+system+readonly,d); 12 | while (doserror = 0) do begin 13 | process(d.name); 14 | findnext(d); 15 | end; 16 | 17 | { this gets the subs, recursively } 18 | findfirst(dir+'\*.*',directory,d); 19 | while (doserror = 0) do begin 20 | if (d.attr and directory = directory) then 21 | ProcessAllFiles(dir+'\'+d.name); 22 | findnext(d); 23 | end; 24 | 25 | end; 26 |  -------------------------------------------------------------------------------- /screen/0054.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I have always addressed $B800 as the screen segment for direct video 3 | > writes in text.... Err, umm, does anyone have the code to detect 4 | > whether it is $B000 or $B800 (for Herc.'s and the like)... 5 | 6 | call the Bios INt $10 Function $0f to get video mode. 7 | } 8 | 9 | Function GetVideoSegment:Word; 10 | Begin 11 | Asm 12 | Mov AH,$0f; 13 | INT $10; 14 | Cmp AL, $07; { Monochrome? } 15 | Jne @No; 16 | Mov @Result, $B000; 17 | Jmp @Done; 18 | @No: Mov @Result, $B800; 19 | @Done: 20 | End; 21 | End; 22 | 23 | begin 24 | Write( GetVideoSegment); 25 | End. 26 |  -------------------------------------------------------------------------------- /streams/dir.txt: -------------------------------------------------------------------------------- 1 | SWAG Title: STREAM HANDLING ROUTINES 2 | 0001.PAS 05-28-93 13:57 "STREAMS1.PAS" by SWAG SUPPORT TEAM 3 | 0002.PAS 05-28-93 13:57 "STREAMS2.PAS" by SWAG SUPPORT TEAM 4 | 0003.PAS 11-26-94 04:57 "TEMSStream.Done Bug" by DJ MURDOCH & ALEXANDER PETROSYAN 5 | 0004.PAS 11-26-94 04:57 "Stream Storage Unit" by MARCOS DELLA 6 | 0005.PAS 02-28-95 09:59 "A streaming method for EXE's" by CHRISTIAN TIBERG 7 | 0006.PAS 02-28-95 10:09 "Simple STREAM Example" by SWAG SUPPORT TEAM 8 | 0007.PAS 05-26-95 23:07 "Finding the Number of Entries in a Strea" by LEW ROMNEY 9 | 0008.PAS 09-04-95 10:59 "LARGE MEMORY STREAMS" by SWAG SUPPORT TEAM 10 | -------------------------------------------------------------------------------- /delphi/0099.pas: -------------------------------------------------------------------------------- 1 | { 2 | In article 25@mailhost.primenet.com, rkr@primenet.com writes: 3 | >Is there a way in a TMemo object to set the text margin from the left and or t 4 | op?? 5 | > 6 | >Meaning , all the text going down the left side of the memo would start let's 7 | say, 8 | >10 pixels over instead of right up against the side of the Memo ?? 9 | > 10 | } 11 | 12 | procedure TEditForm.SetEditRect; 13 | Var 14 | R : TRect; 15 | begin 16 | R := DisplayMemo.ClientRect; 17 | R.Left:=R.Left + kMemoIndent; 18 | R.Top:=R.Top + 2; 19 | R.Bottom:=R.Bottom - 2; 20 | R.Right:=R.Right - kMemoIndent; 21 | SendMessage(DisplayMemo.Handle, EM_SETRECT, 0, Longint(@R)); 22 | end; 23 |  -------------------------------------------------------------------------------- /graphics/0118.pas: -------------------------------------------------------------------------------- 1 | { 2 | GK> I have a slight problem. I have written a program that runs in 3 | GK> graphics mode ($13). I use the following routine to get what 4 | GK> colour is at that pixel :- 5 | GK> PixelColor := MEM[$A000:X + (Y*320)]; 6 | GK> This works fine, but it is rather slow. I was wondering if 7 | GK> anybody knew how to do this faster? 8 | } 9 | 10 | Function PixColor(x, y : Word) : Byte; Assembler; 11 | Asm 12 | push ds 13 | mov ax,0a000h 14 | mov ds,ax 15 | mov ax,y 16 | shl ax,6 17 | mov si,ax 18 | shl ax,2 19 | add si,ax 20 | add si,x 21 | lodsb 22 | pop ds 23 | End; 24 |  -------------------------------------------------------------------------------- /hardware/0011.pas: -------------------------------------------------------------------------------- 1 | { 2 | Does anyone out there know how to set the Software Turbo Speed on Mother 3 | boards without hitting the Turbo Switch or the <-> key to 4 | slow the system and or Speed it up again? Thanks... 5 | } 6 | 7 | Uses 8 | Dos; 9 | 10 | Procedure SetSpeed(Turbo : Boolean); 11 | Var 12 | Regs : Registers; 13 | OldMem : Byte; 14 | 15 | begin 16 | {OldMem := Mem[$40 : $17];} 17 | If Turbo then 18 | Regs.AL := 78 19 | else 20 | Regs.AL := 74; 21 | 22 | {Mem[$40 : $17] := 140;} 23 | Regs.AH := $4F; 24 | Intr($15, Regs); 25 | {Mem[$40 : $17] := OldMem;} 26 | end; 27 | 28 | begin 29 | SetSpeed(False); 30 | end. 31 |  -------------------------------------------------------------------------------- /math/0069.pas: -------------------------------------------------------------------------------- 1 | 2 | Function CheckPrime(a : integer) : boolean; 3 | Var 4 | x : integer; 5 | y : integer; 6 | Begin 7 | y:=0; 8 | for x:=1 to (a div 2) do {Only #s up to half of a can be factors} 9 | begin 10 | if (a mod x)=0 then y:=(y+1) 11 | end; 12 | if y=2 then checkprime:=true else checkprime:=false; 13 | if a=1 then checkprime:=true; 14 | End; 15 | 16 | You see, only prime numbers have exactly two factors, themselves and one. 17 | With the exception of One. Therefore you have a specific IF for the 18 | number one. One is prime, yet its only factor is one. I think - Is one 19 | prime or not? Anyway, remove that line if it isn't, the function will work. 20 |  -------------------------------------------------------------------------------- /memory/0084.pas: -------------------------------------------------------------------------------- 1 | 2 | program FillMem; 3 | 4 | uses 5 | OpRoot; 6 | 7 | const 8 | FillCh : Byte = 0; 9 | 10 | var 11 | P : Pointer; 12 | A : Word; 13 | B : Boolean; 14 | S : String[3]; 15 | 16 | 17 | begin 18 | if ParamCount <> 0 then begin 19 | S := ParamStr(1); 20 | if S[1] <> '$' then 21 | S := '$'+S; 22 | Val(S, FillCh, A); 23 | if A <> 0 then exit; 24 | end; 25 | 26 | A := $8000; 27 | while True do begin 28 | B := GetMemCheck(P, A); 29 | if B then 30 | FillChar(P^, A, FillCh) 31 | else begin 32 | if A <= 8 then exit; 33 | A := A shr 1; 34 | end; 35 | end; 36 | end. 37 | 38 | 39 |  -------------------------------------------------------------------------------- /comm/0010.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I started writing communicating-Programs, and even 3 | > trying to develope simple doors. But, i have one 4 | > little problem: I don't know how to hang-up the modem! 5 | > - I am using a ready-made TPU that does all the port 6 | > tasks, but it just can't hang up! 7 | > All i know, is beFore the ~~~+++~~~ATH0 String, i need to 'Drop DTR'... 8 | > How do i do that?!? 9 | 10 | if you are using a FOSSIL driver For communications, you could do this: 11 | } 12 | 13 | Procedure Lower_DTR; 14 | Var regs:Registers; 15 | begin 16 | regs.dx:=0; {com1=0;com2=1;com3=2;com4=3} 17 | regs.al:=$00; 18 | regs.ah:=$06; 19 | intr($14,regs); 20 | Exit; 21 | end; 22 | 23 |  -------------------------------------------------------------------------------- /copymove/0013.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anybody know how to do a "fast" move of a File? 3 | > ie: not copying it but just moving the FAT Record 4 | 5 | Yup. In Pascal you can do it With the Rename command. The Format is: 6 | 7 | Rename (Var F; NewName : String) 8 | 9 | where F is a File Variable of any Type. 10 | 11 | to move a File Really fast, and to avoid having to copy it somewhere first and 12 | then deleting the original, do this: 13 | } 14 | 15 | Procedure MoveIt; {No error checking done} 16 | Var 17 | F : File; 18 | FName : String; 19 | NName : String; 20 | begin 21 | Assign (F, FName); 22 | NName:= {new directory / File name} 23 | Rename (F, NName); 24 | End. -------------------------------------------------------------------------------- /cursor/0016.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... SetCursor() 3 | * Purpose ....... To set the cursor shape 4 | * Parameters .... nTop Top line of cursor 5 | * nBottom Bottom line of cursor 6 | * Returns ....... N/A 7 | * Notes ......... None 8 | * Author ........ Martin Richardson 9 | * Date .......... May 13, 1992 10 | ****************************************************************************} 11 | PROCEDURE SetCursor( nTop, nBottom : INTEGER ); ASSEMBLER; 12 | ASM 13 | MOV AH, 1 14 | MOV CH, BYTE PTR nTop 15 | MOV CL, BYTE PTR nBottom 16 | INT 10h 17 | END; 18 | 19 |  -------------------------------------------------------------------------------- /delphi/0054.pas: -------------------------------------------------------------------------------- 1 | 2 | function DiskInDrive(Drive: Char): Boolean; 3 | var 4 | ErrorMode: word; 5 | begin 6 | { make it upper case } 7 | if Drive in ['a'..'z'] then Dec(Drive, $20); 8 | { make sure it's a letter } 9 | if not (Drive in ['A'..'Z']) then 10 | raise EConvertError.Create('Not a valid drive ID'); 11 | { turn off critical errors } 12 | ErrorMode := SetErrorMode(SEM_FailCriticalErrors); 13 | try 14 | { drive 1 = a, 2 = b, 3 = c, etc. } 15 | if DiskSize(Ord(Drive) - $40) = -1 then 16 | Result := False 17 | else 18 | Result := True; 19 | finally 20 | { restore old error mode } 21 | SetErrorMode(ErrorMode); 22 | end; 23 | end; 24 |  -------------------------------------------------------------------------------- /files/0028.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... Exist() 3 | * Purpose ....... Checks for the existance of a file/directory 4 | * Parameters .... sExp File/directory name to check for 5 | * Returns ....... TRUE if sExp exists 6 | * Notes ......... Not picky, will even accept wild cards 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | FUNCTION Exist( sExp: STRING ): BOOLEAN; 11 | VAR s : SearchRec; 12 | BEGIN 13 | FINDFIRST( sExp, AnyFile, s ); 14 | Exist := (DOSError = 0); 15 | END; 16 | 17 |  -------------------------------------------------------------------------------- /interrup/0005.pas: -------------------------------------------------------------------------------- 1 | 2 | Registers Demo 3 | 4 | PB> Procedure GetScreenType (Var SType: Char); 5 | PB> Var 6 | PB> Regs: Registers; 7 | PB> begin 8 | PB> Regs.AH := $0F; 9 | PB> Intr($10, Regs); 10 | PB> if Regs.AL = 7 then 11 | PB> sType := 'M'; <<<<< 12 | PB> else 13 | PB> sType := 'C'; 14 | PB> end; 15 | 16 | This Procedure would be ideal For a Function... 17 | Function GetScreenType:Char; 18 | ... 19 | if Regs.AL=7 then 20 | GetScreenType := 'M' 21 | else 22 | GetScreenType := 'C'; 23 | ... 24 |  -------------------------------------------------------------------------------- /redirect/dir.txt: -------------------------------------------------------------------------------- 1 | SWAG Title: DOS REDIRECTION ROUTINES 2 | 0001.PAS 05-28-93 13:56 "DOS-REDR.PAS" by SWAG SUPPORT TEAM 3 | 0002.PAS 05-28-93 13:56 "DUALOUT.PAS" by SWAG SUPPORT TEAM 4 | 0003.PAS 05-28-93 13:56 "REDIRCT1.PAS" by SWAG SUPPORT TEAM 5 | 0004.PAS 05-28-93 13:56 "REDIRCT2.PAS" by SWAG SUPPORT TEAM 6 | 0005.PAS 05-28-93 13:56 "REDIRCT3.PAS" by SWAG SUPPORT TEAM 7 | 0006.PAS 01-27-94 12:19 "Redirection" by FRED JOHNSON 8 | 0007.PAS 08-25-94 09:10 "Redirect output" by TODD A. JACOBS 9 | 0008.PAS 08-25-94 09:11 "EXEC with i/o redirection" by MATTHEW MASTRACCI 10 | 0009.PAS 05-26-95 23:24 "Redirecting PKZIP/PKUNZIP" by MARK OUELLET 11 | -------------------------------------------------------------------------------- /textwndw/0023.pas: -------------------------------------------------------------------------------- 1 | 2 | {NOTE: "VS" is the video segment, $B800 for color, 3 | $B800 for mono. Attribute is "FORECOLOR + (BACKGROUND shl 4);" it is 4 | normally set to 8. } 5 | 6 | procedure SetChAttr(x, y, attr: byte); 7 | begin 8 | Mem[VS:160*(Y-1)+2*(X-1)+1] := attr; 9 | end; 10 | 11 | 12 | procedure Shade(X, Y, X2, Y2, attr: byte); 13 | var 14 | Cnt: byte; 15 | wh: word; 16 | begin 17 | for Cnt := Y+1 to y2+1 do 18 | begin 19 | SetChAttr(x2+1, cnt, attr); 20 | SetChAttr(x2+2, cnt, attr); 21 | end; 22 | 23 | for Cnt := x+2 to x2-1 do 24 | begin 25 | SetChAttr(Cnt, y2+1, Attr); 26 | SetChAttr(Cnt+1, y2+1, Attr); 27 | end; 28 | end; 29 |  -------------------------------------------------------------------------------- /delphi/0043.pas: -------------------------------------------------------------------------------- 1 | 2 | Moving to a page by name on a TabSet. 3 | 4 | Place a Tabset(TabSet1) and an Edit (Edit1) on 5 | your form. Change the Tabset's Tabs Property in 6 | the String List Editor to include 4 Tabs: 7 | Hello, 8 | World, 9 | Of, 10 | Delphi, 11 | 12 | Change Edit1's onChange event to: 13 | 14 | procedure TForm1.Edit1Change(Sender: TObject); 15 | var 16 | I : Integer; 17 | begin 18 | for I:= 0 to tabset1.tabs.count-1 do 19 | if edit1.text = tabset1.tabs[I] then 20 | tabset1.tabindex:=I; 21 | 22 | end; 23 | 24 | If You type any of the Tabs names in edit1 it 25 | will focus on the appropriate tab. 26 | 27 |  -------------------------------------------------------------------------------- /tsr/0035.pas: -------------------------------------------------------------------------------- 1 | { 2 | > upon another problem: how do I detect the "presence" of a 3 | > self-developed TSR, which I made resident with KEEP(0) ? 4 | } 5 | 6 | VAR 7 | HandlerSeg : WORD; 8 | 9 | Begin 10 | asm 11 | mov ax, $3565 12 | int $21 13 | mov Handlerseg, es 14 | End; 15 | 16 | IF (Handlerseg <> $FFFF) THEN 17 | Begin 18 | asm 19 | push ds 20 | mov ax, $FFFF 21 | mov ds, ax 22 | mov ax, $2565 23 | mov dx, $0000 24 | int $21 25 | pop ds 26 | End; 27 | End 28 | ELSE 29 | Begin 30 | WriteLn( 'Program already installed.' ); 31 | Halt( 0 ); 32 | End; 33 | 34 | { Blah blah blah } 35 | End. 36 |  -------------------------------------------------------------------------------- /dos/0080.pas: -------------------------------------------------------------------------------- 1 | (* 2 | I asked Quarterdeck's tech support about the reboot sequence I use, which 3 | flushes buffers before booting, and they recommended also setting the stack 4 | to non-mappable memory when booting from a DESQview window (the lines below 5 | marked by {*} 6 | *) 7 | 8 | program boot; 9 | procedure ReBoot; far; assembler; 10 | asm 11 | mov ah, 0Dh 12 | int 21h 13 | xor cx, cx 14 | @1: 15 | push cx 16 | int 28h 17 | pop cx 18 | loop @1 19 | mov ds, cx 20 | mov word ptr [472h], 1234h 21 | mov ss, cx {*} 22 | mov sp, 700h {*} 23 | dec cx 24 | push cx 25 | push ds 26 | end; 27 | begin 28 | ReBoot; 29 | end. 30 |  -------------------------------------------------------------------------------- /egavga/0012.pas: -------------------------------------------------------------------------------- 1 | { 2 | Here's a quick proc. to return the current video mode: 3 | } 4 | 5 | Uses 6 | Dos; 7 | 8 | Function CurVidMode : Byte; 9 | 10 | Var 11 | Regs : Registers; 12 | 13 | begin; 14 | 15 | Regs.Ah :=$f; 16 | Intr($10, Regs); 17 | CurVidMode := Regs.Al; 18 | 19 | end; 20 | 21 | begin 22 | Writeln(CurVidMode); 23 | end. 24 | 25 | 26 | { 27 | You can use that same color Procedure For the VGA 16 color mode because 28 | although it can only do 16 colors, it can still change each of the 16 29 | colors to 64*64*64 (262,144) colors, like the 256 color mode. 30 | 31 | About the EGA palette - I'll have to get back to ya, that's more 32 | complex. 33 | } 34 | 35 |  -------------------------------------------------------------------------------- /timing/0031.pas: -------------------------------------------------------------------------------- 1 | { 2 | From: Andrew Eigus Read: Yes Replied: No 3 | } 4 | 5 | Procedure Pause(HS : longint); assembler; 6 | Asm 7 | mov es,Seg0040 8 | mov si,006Ch 9 | mov dx,word ptr es:[si+2] 10 | mov ax,word ptr es:[si] 11 | add ax,word ptr [HS] 12 | adc dx,word ptr [HS+2] 13 | @@1: 14 | mov bx,word ptr es:[si+2] 15 | cmp word ptr es:[si+2],dx 16 | jl @@1 17 | mov cx,word ptr es:[si] 18 | cmp word ptr es:[si],ax 19 | jl @@1 20 | End; { Pause } 21 | { 22 | The above routine does not depend on a CPU speed. 23 | } 24 |  -------------------------------------------------------------------------------- /screen/0052.pas: -------------------------------------------------------------------------------- 1 | { 2 | > repeat until (port[$3da] and $08) = 0; 3 | > repeat until (port[$3da] and $08) <> 0; 4 | > The above code is some I've abducted from this echo. It waits for a 5 | > 'retrace' (sp). 6 | > Does anyone have faster code to wait for a retrace? This code seems to 7 | > greatly slow down my programs on certain (slower) computers. 8 | 9 | I think TP is fast enough for that, because your video card needs much time 10 | to display the screen. Perhaps this is a little bit faster on REALLY slow 11 | machines: 12 | } 13 | 14 | Asm 15 | MOV DX,$03DA 16 | @@1: 17 | IN DX,AX 18 | TEST AX,$08 19 | JZ @@1 20 | @@2: 21 | IN DX,AX 22 | TEST AX,$08 23 | JNZ @@2 24 | End; 25 | 26 |  -------------------------------------------------------------------------------- /files/0007.pas: -------------------------------------------------------------------------------- 1 | { 1 } 2 | 3 | Function FileExist(FileName : String) : Boolean; 4 | begin 5 | FileExist := (FSearch(FileName, '') <> '') 6 | end; (* FileExist. *) 7 | 8 | { 2 } 9 | 10 | Function FileExist(FileName : String) : Boolean; 11 | Var 12 | SRec : SearchRec; 13 | begin 14 | FindFirst(FileName, AnyFile, SRec); 15 | FileExist := (DosError = 0); 16 | end; 17 | 18 | { 3 } 19 | 20 | Function FileExists(FileName : String) : Boolean; 21 | Var 22 | DirInfo : SearchRec; 23 | begin 24 | FindFirst(FileName, AnyFile, DirInfo); 25 | if (DosError = 0) then 26 | FileExists := True 27 | else 28 | FileExists := False; 29 | end; 30 | 31 |  -------------------------------------------------------------------------------- /delphi/0035.pas: -------------------------------------------------------------------------------- 1 | 2 | Doing an UnDo in a Memo Field: 3 | 4 | If you have a pop-up menu in a TMemo, and put shortcuts 5 | on it for the Cut,Copy, Paste, then you can handle those 6 | events, and call CuttoClipBoard, CopytoClipBoard, etc. 7 | 8 | However, if you put an Undo option onto your pop-up menu 9 | (normally Ctrl-Z) how do you instruct the TMemo to do the Undo? 10 | If the built-in undo is sufficient, you can get it easier than 11 | a Ctrl+Z: 12 | 13 | Memo1.Perform(EM_UNDO, 0, 0); 14 | 15 | To check whether undo is available so as to enable/disable 16 | 17 | an undo menu item: 18 | 19 | Undo1.Enabled := Memo1.Perform(EM_CANUNDO, 0, 0) <> 0; 20 | 21 | 22 | 23 | 24 |  -------------------------------------------------------------------------------- /delphi/0368.pas: -------------------------------------------------------------------------------- 1 | 2 | I'm trying to add a delay of a few seconds into a formless DLL written in 3 | Delphi 4 | 5 | Using the VCL TTimer seems to be precluded because it is a component, 6 | and its create method is looking for that all familiar Sender:TComponent, =20= 7 | 8 | The following function should work in both 16 and 32 bit environment 9 | 10 | Procedure GoSleep(SleepFor: DWord); 11 | var 12 | StartTicks: LongInt; 13 | Begin 14 | {$IfDef Win16} 15 | StartTicks := GetTickCount + SleepFor; 16 | While GetTickCount < StartTicks Do 17 | Begin 18 | //Optional 19 | Application=ProcessMessages; 20 | End; 21 | {$Else} 22 | Sleep(SleepFor); 23 | {$EndIf} 24 | End; 25 |  -------------------------------------------------------------------------------- /drives/0109.pas: -------------------------------------------------------------------------------- 1 | Unit Tools; 2 | Interface 3 | 4 | Function DriveValid(Drive: Char): Boolean; 5 | Function SelectDrive(Drive: Char): Word; 6 | 7 | Implementation 8 | 9 | Function DriveValid; 10 | Assembler; 11 | Asm 12 | Mov Ah,19h 13 | Int 21h 14 | Mov Bl,Al 15 | Mov Dl,Drive 16 | Sub Dl,'A' 17 | Mov Ah,0Eh 18 | Int 21h 19 | Mov Ah,19h 20 | Int 21h 21 | Mov Cx,0 22 | Cmp Al,Dl 23 | Jne @@1 24 | Mov Cx,1 25 | Mov Dl,Bl 26 | Mov Ah,0Eh 27 | Int 21h 28 | @@1: 29 | Xchg Ax,Cx 30 | End; 31 | 32 | Function SelectDrive; 33 | Assembler; 34 | Asm 35 | Mov Dl,Drive 36 | Sub Dl,'A' 37 | Mov Ah,0Eh 38 | Int 21h 39 | End; 40 | 41 | End. 42 |  -------------------------------------------------------------------------------- /encrypt/0004.pas: -------------------------------------------------------------------------------- 1 | Function EncryptDecrypt(S : String : K : String) : String; 2 | Var 3 | I,Q : Integer; 4 | O : String[255]; 5 | begin 6 | Q := 1; 7 | O := ""; 8 | For I := 1 to Length(S) Do 9 | begin 10 | O := O + Chr(Ord(S[I]) Xor Ord(K[Q])); 11 | Inc(Q); If Q > Length(K) Then Q := 1; 12 | end; 13 | EncryptDecrypt := O; 14 | end; 15 | 16 | A couple of thoughts on this. 17 | 18 | 1. If K is short then the decryption is very easy. 19 | 2. The routine would be VERY slow as it is using String concatenation. It 20 | would be MUCH faster if the O := "" line was changed to O[0] := S[0] and 21 | the O := O + ... line was replaced With - 22 | O[I] := ... 23 | 24 | TeeCee 25 |  -------------------------------------------------------------------------------- /color/0016.pas: -------------------------------------------------------------------------------- 1 | {YZ> Does anyone know how to "extract" the foreground and background 2 | YZ> colours from TextAttr? 3 | } 4 | 5 | Foreground := TextAttr and $0f; 6 | Background := (TextAttr and $f0) shr 4; 7 | 8 | {A few days ago, I read a message from someone who was trying to extract 9 | foreground and background colors from one Byte Variable. I have since 10 | lost the mail packet, and forgotten the user's name, but here's a 11 | routine that will do that anyways. Hope it gets to the person who was 12 | asking For it...... 13 | } 14 | Procedure GetColors(Color : Byte; Var BackGr : Byte; Var ForeGr : Byte); 15 | begin 16 | BackGr := Color shr 4; 17 | ForeGr := Color xor (Background shl 4); 18 | end; 19 | 20 |  -------------------------------------------------------------------------------- /egavga/0008.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I once saw a Procedure that set the palette With RGB inputs, like the 3 | > 256- colour palette setter (RGBSetPalette). It used some SHLs 4 | > and SHRs to reduce the inputted values For red, green, and 5 | > blue to 2-bit values (or somewhere around there). 6 | } 7 | 8 | Procedure EGAPalette(c_index, red, green, blue : Byte); 9 | Var 10 | i : Integer; 11 | regs : Registers; 12 | begin 13 | red := red SHR 6; 14 | green := green SHR 6; 15 | blue := blue SHR 6; 16 | i := (red SHL 4) + (green SHL 2) + blue; 17 | regs.AH := $10; 18 | regs.AL := 0; 19 | regs.BH := i; 20 | regs.BL := c_index; { the colour index to change } 21 | Intr($10, regs); 22 | end; 23 | 24 |  -------------------------------------------------------------------------------- /egavga/0011.pas: -------------------------------------------------------------------------------- 1 | { 2 | GRADY WERNER 3 | Put these in your code For GREAT, FAST RGB Palette Changing... 4 | } 5 | Procedure ASetRGBPalette(Color, Red, Green, Blue : Byte); 6 | begin 7 | Port[$3C8]:=Color; 8 | Port[$3C9]:=Red; 9 | Port[$3C9]:=Green; 10 | Port[$3C9]:=Blue; 11 | end; 12 | 13 | { 14 | This Procedure Changes palette colors about 400% faster than the 15 | built-in routines. Also, a problem With flicker may have been encountered 16 | with Turbo's Putimage Functions. Call this Procedure RIGHT BEFORE the 17 | putimage is called... Viola... NO Flicker! 18 | } 19 | Procedure WaitScreen; 20 | begin 21 | Repeat Until (Port[$3DA] and $08) = 0; 22 | Repeat Until (Port[$3DA] and $08) <> 0; 23 | end; 24 |  -------------------------------------------------------------------------------- /math/0091.pas: -------------------------------------------------------------------------------- 1 | { 2 | >> Is there a faster way to find the GCD of two numbers than 3 | >> Euclid's algorithm? 4 | 5 | > Euclid's algorithm isn't fast enough for you? 6 | 7 | Oh yes, I gather it is, but I'm interested in whether there are faster 8 | ways or not. 9 | 10 | > quick div or mod. The following should be fast enough. 11 | > function GCD( u, v : LongInt) : LongInt; 12 | 13 | Here's my implementation: 14 | } 15 | 16 | function gcd(a, b : word) : word; assembler; 17 | asm 18 | mov ax,a 19 | mov bx,b 20 | @start: 21 | or bx,bx 22 | jz @endgcd 23 | xor dx,dx 24 | div bx 25 | mov ax,bx 26 | mov bx,dx 27 | jmp @start 28 | @endgcd: 29 | end; 30 | 31 |  -------------------------------------------------------------------------------- /numbers/0028.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... wLo() 3 | * Purpose ....... Return the low order word from a longint (double word) 4 | * Parameters .... n LONGINT to retrieve low word from 5 | * Returns ....... Low word from n 6 | * Notes ......... LO only returns the LOw byte from a word. I needed 7 | * something that returned the low WORD from a LONGINT. 8 | * Author ........ Martin Richardson 9 | * Date .......... October 9, 1992 10 | *****************************************************************************} 11 | FUNCTION wLo( n: LONGINT ): WORD; ASSEMBLER; 12 | ASM 13 | MOV AX, WORD PTR n[0] 14 | END; 15 | 16 |  -------------------------------------------------------------------------------- /copymove/0001.pas: -------------------------------------------------------------------------------- 1 | Program Copy; 2 | 3 | Var InFile, OutFile : File; 4 | Buffer : Array[ 1..512 ] Of Char; 5 | NumberRead, 6 | NumberWritten : Word; 7 | 8 | begin 9 | If ParamCount <> 2 Then Halt( 1 ); 10 | Assign( InFile, ParamStr( 1 ) ); 11 | Reset ( InFile, 1 ); {This is Reset For unTyped Files} 12 | Assign ( OutFile, ParamStr( 2 ) ); 13 | ReWrite ( OutFile, 1 ); {This is ReWrite For unTyped Files} 14 | Repeat 15 | BlockRead ( InFile, Buffer, Sizeof( Buffer ), NumberRead ); 16 | BlockWrite( OutFile, Buffer, NumberRead, NumberWritten ); 17 | Until (NumberRead = 0) or (NumberRead <> NumberWritten); 18 | Close( InFile ); 19 | Close( OutFile ); 20 | end. 21 |  -------------------------------------------------------------------------------- /dos/0028.pas: -------------------------------------------------------------------------------- 1 | {**************************************************************************** 2 | * Procedure ..... StandardIO 3 | * Purpose ....... To allow input/output redirection from the DOS command 4 | * line. 5 | * Parameters .... None 6 | * Returns ....... N/A 7 | * Notes ......... Normal TP writes do not allow i/o redirection. This is a 8 | * fix for that. 9 | * Author ........ Martin Richardson 10 | * Date .......... May 13, 1992 11 | ****************************************************************************} 12 | PROCEDURE StandardIO; 13 | BEGIN 14 | ASSIGN( Input, '' ); 15 | RESET( Input ); 16 | ASSIGN( Output, '' ); 17 | REWRITE( Output ); 18 | END; 19 |  -------------------------------------------------------------------------------- /numbers/0027.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... wHi() 3 | * Purpose ....... Return the High order word from a longint (double word) 4 | * Parameters .... n LONGINT to retrieve high word from 5 | * Returns ....... High word from n 6 | * Notes ......... HI only returns the HIgh byte from a word. I needed 7 | * something that returned the high WORD from a LONGINT. 8 | * Author ........ Martin Richardson 9 | * Date .......... October 9, 1992 10 | *****************************************************************************} 11 | FUNCTION wHi( n: LONGINT ): WORD; ASSEMBLER; 12 | ASM 13 | MOV AX, WORD PTR n[2] 14 | END; 15 | 16 |  -------------------------------------------------------------------------------- /comm/0002.pas: -------------------------------------------------------------------------------- 1 | { 2 | >Does anyone know how to detect when the modem connects?? Thanks. 3 | 4 | Through the BIOS: 5 | } 6 | 7 | Function CarrierDetected(Port : Word) : Boolean; 8 | Const 9 | DCD = $80; 10 | Var 11 | Dummy : Byte; 12 | begin 13 | Asm 14 | dec port 15 | mov ah,03h 16 | mov dx,port 17 | int 14h 18 | mov dummy,al 19 | end; 20 | CarrierDetected := (Dummy and DCD) = DCD { carrier detected } 21 | end; 22 | 23 | { Or directly: } 24 | 25 | Function CarrierDetected(Port : Byte) : Boolean; 26 | begin 27 | Case Port of 28 | 1: CarrierDetected := ($3FE and $80) = $80; { com 1 cd } 29 | 2: CarrierDetected := ($2FE and $80) = $80 { com 2 cd } 30 | end 31 | end; 32 |  -------------------------------------------------------------------------------- /delphi/0112.pas: -------------------------------------------------------------------------------- 1 | { 2 | When dealing with multiple drives, it is helpful to know 3 | whether a drive is associated with a is attached to a letter 4 | (A, B, C, etc), and what its type is. This code uses the API 5 | GetDriveType function to do that. } 6 | 7 | function ShowDriveType(DriveLetter: char): string; 8 | var 9 | i: word; 10 | begin 11 | if DriveLetter in ['A'..'Z'] then {Make it lower case.} 12 | DriveLetter := chr(ord(DriveLetter) + $20); 13 | i := GetDriveType(ord(DriveLetter) - ord('a')); 14 | case i of 15 | DRIVE_REMOVABLE: result := 'floppy'; 16 | DRIVE_FIXED: result := 'hard disk'; 17 | DRIVE_REMOTE: result := 'network drive'; 18 | else result := 'does not exist'; 19 | end; 20 | end; 21 |  -------------------------------------------------------------------------------- /delphi/0378.pas: -------------------------------------------------------------------------------- 1 | 2 | function DelphiIsRunning : boolean; 3 | var 4 | H1, H2, H3, H4 : Hwnd; 5 | const 6 | A1 : array[0..12] of char = 'TApplication'#0; 7 | A2 : array[0..15] of char = 'TAlignPalette'#0; 8 | A3 : array[0..18] of char = 'TPropertyInspector'#0; 9 | A4 : array[0..11] of char = 'TAppBuilder'#0; 10 | T1 : array[0..6] of char = 'Delphi'#0; 11 | begin 12 | H1 := FindWindow(A1, T1); 13 | H2 := FindWindow(A2, nil); 14 | H3 := FindWindow(A3, nil); 15 | H4 := FindWindow(A4, nil); 16 | Result := (H1 <> 0) and (H2 <> 0) and 17 | (H3 <> 0) and (H4 <> 0); 18 | end; 19 | 20 | initialization 21 | if DelphiIsRunning then 22 | begin 23 | {Do what you want......} 24 | end; 25 | end. 26 |  -------------------------------------------------------------------------------- /egavga/0025.pas: -------------------------------------------------------------------------------- 1 | { 2 | Well, there are two basic ways of using Graphics mode. 3 | 1) Use the BIOS routines to enter this mode. 4 | 2) Use the BGI (Borland Graphics Interface) used With the Graph Unit 5 | and the appropriate BGI File (as mentioned by you). 6 | 7 | Since you intend to display PCX Files, I guess you have no business 8 | with the Graph Unit and the BGI, so I suggest the first way. 9 | 10 | Example: 11 | } 12 | 13 | Program Enter256; 14 | 15 | Uses 16 | Dos; 17 | 18 | Var 19 | Regs : Registers; 20 | 21 | begin 22 | Regs.Ah := 0; 23 | Regs.Al := $13; 24 | Intr($10, Regs); 25 | 26 | Readln; 27 | end. 28 | 29 | { 30 | At the end of this Program you will be in 320x200 256 color mode. 31 | } -------------------------------------------------------------------------------- /math/0056.pas: -------------------------------------------------------------------------------- 1 | { 2 | This is a small program which is faster than any of the writings on the echo 3 | on calculating Pi. It uses some Calculus (In an exam I did 2/3 weeks ago). 4 | } 5 | 6 | Program CalcPi; 7 | {$N+,E+} 8 | 9 | Var 10 | Result : Extended; 11 | A : Byte; 12 | 13 | begin 14 | Result := 3; {Needs a approximation of Pi} 15 | For A := 1 to 3 do {Only needs three goes to get as accurate as possible 16 | with TP variables.} 17 | begin 18 | RESULT := RESULT - Sin(result) * Cos(result); 19 | {this is a simplified version of Newton Raphson Elimation using Tan(Pi)=0} 20 | Writeln(RESULT : 0 : 18); 21 | {18 decimal places - as good as TP gets } 22 | end; 23 | end. 24 |  -------------------------------------------------------------------------------- /strings/0029.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... AllTrim() 3 | * Purpose ....... To trim off spaces from either side of a string 4 | * Parameters .... str String to trim 5 | * Returns ....... str with leading and trailing spaces removed 6 | * Notes ......... Uses function LTrim and RTrim 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | FUNCTION AllTrim( str : STRING ) : STRING; 11 | BEGIN 12 | IF LENGTH( Str ) > 0 THEN 13 | AllTrim := LTrim(RTrim(str, ' '), ' ') 14 | ELSE 15 | AllTrim := Str; 16 | END; 17 | 18 |  -------------------------------------------------------------------------------- /archives/0031.pas: -------------------------------------------------------------------------------- 1 | 2 | { Updated ARCHIVES.SWG on May 26, 1995 } 3 | 4 | { 5 | > Therefore I need the fileformats of all 6 | > known archive types. And in special: 7 | 8 | Here are the ones I know there OffSet in the File and the Sig. 9 | 10 | Format OffSet ASCII Sequence 11 | ------ ------ -------------- 12 | 13 | ZIP 1 #80 + #75 + #3 + #4 14 | ARJ 1 #96 + #232 15 | LHA 3 #45 + #108 + #104 16 | ZOO 1 #90 + #79 + #79 17 | SQZ 1 #72 + #76 + #83 + #81 + #90 18 | PAK 1 #26 + #10 19 | ARC 1 #26 20 | } 21 |  -------------------------------------------------------------------------------- /delphi/0366.pas: -------------------------------------------------------------------------------- 1 | 2 | QuickReport includes the TQRListBuilder, a component for dynamically 3 | creating a simple list report with only a few lines of code. You can 4 | assign the report's dataset to your grid's datasource.dataset and have a 5 | report that displays the same data as your grid: 6 | 7 | 8 | procedure TformMain.ToolButton1Click(Sender: TObject); 9 | var 10 | aReport : TQuickRep; 11 | begin 12 | with TQRListBuilder.Create(Self) do 13 | try 14 | DataSet := DBGrid1.DataSource.DataSet; 15 | Active := True; 16 | try 17 | aReport := FetchReport; 18 | aReport.Preview; 19 | finally 20 | aReport.Free; 21 | end; 22 | finally 23 | Free; 24 | end; 25 | end; 26 |  -------------------------------------------------------------------------------- /faq/0004.pas: -------------------------------------------------------------------------------- 1 | 2 | TP 5.0 5.5 - LINKER ELIMINATES UNUSED DATA 3 | Q. Does the built-in linker eliminate unused data? 4 | A. Yes. Unused code AND data are stripped when you compile to 5 | disk. However, if more than one variable is defined in the 6 | same VAR block and any one is used, the others will not be 7 | stripped from the .EXE. For example: 8 | 9 | var A, B: integer; 10 | var C: integer; 11 | begin 12 | A:= 0; 13 | end. 14 | 15 | In this example, although variable B is never used, it was 16 | defined in the same block as a variable A. Therefore, B will 17 | not be linked out. Variable C will be removed from the .EXE as 18 | it is not used and is not in the same VAR block. 19 | 20 |  -------------------------------------------------------------------------------- /keyboard/0046.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... IsKeyPressed 3 | * Purpose ....... To determine if *ANY* key is pressed on the keyboard 4 | * Parameters .... None 5 | * Returns ....... TRUE if a key is being pressed 6 | * Notes ......... Even returns TRUE if a shift/ctrl/alt/caps lock key is 7 | * pressed. 8 | * Author ........ Martin Richardson 9 | * Date .......... May 13, 1992 10 | *****************************************************************************} 11 | FUNCTION IsKeyPressed: BOOLEAN; 12 | BEGIN 13 | IsKeyPressed := ((MEM[$40:$17] AND $0F) > 0) OR (MEM[$40:$18] > 0) 14 | OR KEYPRESSED; 15 | END; 16 | 17 |  -------------------------------------------------------------------------------- /printing/0035.pas: -------------------------------------------------------------------------------- 1 | { 2 | >> I'm using TP6 and plan to use to the PRINTER.TPU unit the 3 | >> write to the printer. How do you detect whether the printer 4 | >> is on or not without ending up a dos error and the program 5 | >> halting. 6 | 7 | You need to check the status of the printer port. Something like 8 | this: 9 | } 10 | 11 | function TESTONLINE : Byte; { Tests for Printer On Line } 12 | var REGS : Registers; 13 | begin 14 | with REGS do 15 | begin 16 | AH := 2; DX := 0; 17 | Intr($17, Dos.Registers(REGS)); 18 | TESTONLINE := AH 19 | end 20 | end; { TESTONLINE } 21 | 22 | if TESTONLINE = 144 then okay_to_print 23 | else printer_not_ready 24 | 25 |  -------------------------------------------------------------------------------- /strings/0053.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... RTrim() 3 | * Purpose ....... To trim a character off the right side of a string 4 | * Parameters .... s String to trim 5 | * c Character to trim from 6 | * Returns ....... with all characters removed from the right side 7 | * Notes ......... None 8 | * Author ........ Martin Richardson 9 | * Date .......... October 2, 1992 10 | *****************************************************************************} 11 | FUNCTION RTrim( s: STRING; c: CHAR ): STRING; 12 | BEGIN 13 | WHILE (LENGTH(s) > 0) AND (s[LENGTH(s)] = c) DO DEC(s[0]); 14 | RTrim := s; 15 | END; 16 | 17 |  -------------------------------------------------------------------------------- /ansi/0011.pas: -------------------------------------------------------------------------------- 1 | > Also does anyone know how to import TheDraw Files into a prg and get 2 | > them to show properly. Thanks. 3 | 4 | Save the Files into Bin Format, then run BinOBJ on them. When you select a 5 | public name, remember that this will be the Procedure's name. 6 | 7 | After that Write: 8 | 9 | Procedure ; External; {$L } 10 | 11 | Walkthrough example: 12 | 13 | 14 | Saved File: Welcom.Bin 15 | 16 | BinOBJ WELCOME WELCOME WELCOMESCREEN 17 | 18 | In pascal: 19 | 20 | Procedure WelcomeScreen; External; {$L WELCOME.OBJ} 21 | 22 | In order to display, dump the Procedure to b800:0 - 23 | 24 | Move(@WelcomeScreen,Mem[$B800:0],4000]; 25 | 26 | 4000 is the size For 80x25. The size is x*y*2. 27 | 28 |  -------------------------------------------------------------------------------- /delphi/0222.pas: -------------------------------------------------------------------------------- 1 | 2 | In the old days writing to ports on your computer was easy; all you had 3 | to do was use the port[ n ] command. 4 | 5 | Delphi no longer supports the port[ n ] command, so you have to use 6 | functions like: 7 | 8 | function ReadPortB( wPort : Word ) : Byte; 9 | begin 10 | asm 11 | mov dx, wPort 12 | in al, dx 13 | mov result, al 14 | end; 15 | end; 16 | 17 | procedure WritePortB( wPort : Word; bValue : Byte ); 18 | begin 19 | asm 20 | mov dx, wPort 21 | mov al, bValue 22 | out dx, al 23 | end; 24 | end; 25 | 26 | 27 | 28 | Of course, your operating system may not let you write to certain ports, 29 | specially if you're running on Windows NT.  -------------------------------------------------------------------------------- /timing/0012.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... Timer 3 | * Purpose ....... Returns the number of seconds since midnight 4 | * Parameters .... None 5 | * Returns ....... Number of seconds since midnight to the 100th decimial place 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | FUNCTION Timer : REAL; 11 | VAR hour, 12 | minute, 13 | second, 14 | sec100 : WORD; 15 | BEGIN 16 | GETTIME(hour, minute, second, sec100); 17 | Timer := ((hour*60*60) + (minute*60) + (second) + (sec100 * 0.01)) 18 | END; 19 | 20 |  -------------------------------------------------------------------------------- /delphi/0215.pas: -------------------------------------------------------------------------------- 1 | program iexplor; 2 | uses 3 | Windows, OLEAuto; 4 | 5 | 6 | procedure OpenInternetExplorer( sURL : string ); 7 | const 8 | csOLEObjName = 'InternetExplorer.Application'; 9 | var 10 | IE : Variant; 11 | WinHanlde : HWnd; 12 | begin 13 | if( VarIsEmpty( IE ) )then 14 | begin 15 | IE := CreateOleObject( csOLEObjName ); 16 | IE.Visible := true; 17 | IE.Navigate( sURL ); 18 | end else 19 | begin 20 | WinHanlde := FindWIndow( 'IEFrame', nil ); 21 | if( 0 <> WinHanlde )then 22 | begin 23 | IE.Navigate( sURL ); 24 | SetForegroundWindow( WinHanlde ); 25 | end else 26 | begin 27 | // handle error ... 28 | end; 29 | end; 30 | end; 31 | 32 | begin 33 | OpenInternetExplorer( 'microsoft.com' ); 34 | end. 35 | 36 |  -------------------------------------------------------------------------------- /keyboard/0062.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Hello all, I am looking for a scancode for the tab key. I am desperate! 3 | > Please, Any code would be apreciated! Help! Netmail if you wish (1:241/99) 4 | 5 | I saw Richard Brown wrote you a reply as a testing program, but it works for 6 | ASCII codes not SCAN codes so : 7 | } 8 | Var 9 | old : Byte; 10 | Begin 11 | WriteLn ('Press any key to begin and ESCAPE to exit.'); 12 | ReadLn; 13 | old:=$FF; 14 | While Port[$60]<>1+$80 Do {Until ESCAPE is released, 1 is ESC scan-code} 15 | Begin 16 | If (old<>Port[$60]) And (Port[$60]<$80) Then 17 | Begin 18 | old:=Port[$60]; 19 | Writeln('Scan code ',old,' pressed - release code is ',old+$80); 20 | End; 21 | End; 22 | End. 23 | 24 |  -------------------------------------------------------------------------------- /keyboard/0094.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I would like to know how to tell whether there is a 101 enhanced keyboard 3 | > attached to a computer or and 84. 4 | 5 | This should work: 6 | } 7 | 8 | function enhanced_keyboard:boolean; assembler; 9 | 10 | asm 11 | mov ah,09h 12 | int 16h {Call Interrupt $16, Function $09} 13 | shr al,1 14 | shr al,1 15 | shr al,1 16 | shr al,1 17 | shr al,1 {Shifts the bits in al right 5 times} 18 | and al,1 {We want to only test the first bit in al} 19 | end; 20 | 21 | { 22 | This will return true if the enchanced keyboard functions are supported. If 23 | you are compiling with the $G+ directive, then change the five 'shr al,1' to 24 | one 'shr al,5'. Hope this helps. 25 | } 26 |  -------------------------------------------------------------------------------- /ansi/0006.pas: -------------------------------------------------------------------------------- 1 | { 2 | ROBERT ROTHENBURG 3 | 4 | For those interested in using ANSI in Turbo Pascal (at least Dos v2-5 5 | ...I don't know if Dos 6 Uses this routine--Interrupt $29--or not) 6 | here's a tip: The "undocumented" Fast PutChar interrupt is used by 7 | ANSI.SYS, and thus anything you send to that interrupt will be 8 | ANSI-interpreted (provided ANSI.SYS is loaded :). 9 | 10 | Use this routine to output a Character to ANSI: 11 | (you'll have to modify it to output Strings, of course). 12 | } 13 | 14 | Uses 15 | Dos; 16 | 17 | Procedure FastPutChar(C : Char); 18 | { Outputs only to "display", not stdout! Uses Dos v2-5. } 19 | Var 20 | Reg : Registers; 21 | begin 22 | Reg.AL := Ord(C); 23 | Intr($29, Reg) 24 | end; 25 | 26 |  -------------------------------------------------------------------------------- /delphi/0114.pas: -------------------------------------------------------------------------------- 1 | { 2 | Password automation 3 | 4 | Q: I have a paradox table that uses a password. How do I make it so 5 | that the form that uses the table comes up without prompting the user 6 | for the password? 7 | 8 | A: The table component's ACTIVE property must be set to FALSE (If 9 | it is active before you have added the pasword, you will be prompted). 10 | Then, put this code in the handler for the form's OnCreate event: 11 | 12 | Session.AddPassword('My secret password'); 13 | Table1.Active := True; 14 | 15 | Once you close the table, you can remove the password with 16 | RemovePassword('My secret password'), or you can remove all current 17 | passwords with RemoveAllPasswords. (Note: This is for Paradox tables 18 | only.) 19 |  -------------------------------------------------------------------------------- /delphi/0220.pas: -------------------------------------------------------------------------------- 1 | 2 | program Netscape; 3 | 4 | uses DDEMan; 5 | 6 | procedure GotoURL( sURL : string ); 7 | var 8 | dde : TDDEClientConv; 9 | begin 10 | dde := TDDEClientConv.Create( nil ); 11 | with dde do 12 | begin 13 | // specify the location of netscape.exe 14 | ServiceApplication :='c:\ns32\program\netscape.exe'; 15 | // activate the Netscape Navigator 16 | SetLink( 'Netscape', 'WWW_Activate' ); 17 | RequestData('0xFFFFFFFF'); 18 | // go to the specified URL 19 | SetLink( 'Netscape', 'WWW_OpenURL' ); 20 | RequestData(sURL+',,0xFFFFFFFF,0x3,,,' ); 21 | // ... 22 | CloseLink; 23 | end; 24 | dde.Free; 25 | end; 26 | 27 | begin 28 | GotoURL('http://www.whatever.com/' ); 29 | end. 30 |  -------------------------------------------------------------------------------- /delphi/0354.pas: -------------------------------------------------------------------------------- 1 | 2 | From: michael@quinto.ruhr.de (Michael Bialas) 3 | 4 | Does anyone know a fast algorithm that replaces all occurences of any 5 | substring sub1 to any string sub2 in any string str. 6 | This should do the job: 7 | 8 | 9 | -------------------------------------------------------------------------------- 10 | 11 | function ReplaceSub(str, sub1, sub2: String): String; 12 | var 13 | aPos: Integer; 14 | rslt: String; 15 | begin 16 | aPos := Pos(sub1, str); 17 | rslt := ''; 18 | while (aPos <> 0) do begin 19 | rslt := rslt + Copy(str, 1, aPos - 1) + sub2; 20 | Delete(str, 1, aPos + Length(sub1)); 21 | aPos := Pos(sub1, str); 22 | end; 23 | Result := rslt + str; 24 | end; 25 |  -------------------------------------------------------------------------------- /egavga/0225.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I would like to work in 640x480x256 BUT well how? I mean I know that you 3 | > have acces to 64k at once not the 265k you need. What MEM location is the 4 | > current work page on? 5 | } 6 | Procedure ChgPage(page : integer); 7 | Begin 8 | Asm 9 | mov ax,$4F05 10 | mov bx,0 11 | mov dx,page 12 | int $10 13 | End; 14 | currpage := page; 15 | End; 16 | { 17 | The above is the VESA standard for changing pages. DOS only allocates 64k of 18 | memory to the video, so to access the full 265k of info, you must switch 19 | between 5 different pages to access all the memory. This isn't the most 20 | efficient procedure considering that it has an int 10h, but at least it will 21 | get you started. 22 | } 23 |  -------------------------------------------------------------------------------- /egavga/0275.pas: -------------------------------------------------------------------------------- 1 | 2 | { Display EGA palette (works only on VGA), Arne de Bruijn, Public Domain } 3 | function EgaPal(I:byte):byte; assembler; 4 | asm 5 | mov dx,3dah 6 | in al,dx { Clear 3c0h flipflop } 7 | mov dl,0c0h { Set port no to 3c0h } 8 | mov al,I 9 | out dx,al { Write palette no to read, turns off screen } 10 | inc dx { Port 3c1h } 11 | in al,dx { Read color } 12 | push ax { Save } 13 | mov dl,0dah { Again clear flipflop } 14 | in al,dx 15 | mov dl,0c0h 16 | mov al,32 { And turn on screen } 17 | out dx,al 18 | pop ax { Restore color } 19 | end; 20 | 21 | var 22 | I:byte; 23 | begin 24 | for I:=0 to 15 do 25 | WriteLn(I:2,'. ',EgaPal(I)); 26 | end. 27 |  -------------------------------------------------------------------------------- /menu/0005.pas: -------------------------------------------------------------------------------- 1 | 2 | {Used like If Menu('ABCDE')='E' then DoWhatever; Or put result in variable} 3 | Function Menu(TheCommands : String) : Char; 4 | Var 5 | GotKey : Boolean; 6 | Inkey : Char; 7 | Counter : Byte; 8 | Begin 9 | GotKey:=False; 10 | FlushBuff; 11 | Repeat 12 | Inkey:=ReadKeySpin(False); 13 | Inkey:=UpCase(Inkey); 14 | For Counter:=1 to Length(TheCommands) do 15 | If (Inkey=TheCommands[Counter]) or (Inkey=#27) then GotKey:=True; 16 | Until GotKey; 17 | Menu:=InKey; 18 | If Inkey=#27 then Begin 19 | ClrScr; 20 | WriteLnColor('`8─`4─`@─ ESC ─`4─`8─'); 21 | End; 22 | End; 23 | 24 | Function YN : Boolean; 25 | Begin 26 | YN:=Menu('YN')='Y'; 27 | End; 28 | 29 |  -------------------------------------------------------------------------------- /printing/0022.pas: -------------------------------------------------------------------------------- 1 | { Number of parallel ports installed in the system. 2 | Part of the Heartware Toolkit v2.00 (HTparal.PAS) for Turbo Pascal. 3 | Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal. 4 | I can also be reached at RIME network, site ->TIB or #5314. 5 | Feel completely free to use this source code in any way you want, and, if 6 | you do, please don't forget to mention my name, and, give me and Swag the 7 | proper credits. } 8 | 9 | FUNCTION Parallel_Ports : byte; 10 | { DESCRIPTION: 11 | Number of parallel ports installed in the system. 12 | SAMPLE CALL: 13 | NB := Parallel_Ports; } 14 | 15 | BEGIN { Parallel_Ports } 16 | Parallel_Ports := MemW[$0000:$0410] shr 14; 17 | END; { Parallel_Ports } 18 |  -------------------------------------------------------------------------------- /delphi/0065.pas: -------------------------------------------------------------------------------- 1 | 2 | type 3 | TForm2 = class(TForm) 4 | { other stuff above } 5 | procedure CreateParams(var Params: TCreateParams); override; 6 | { other stuff below } 7 | end; 8 | 9 | 10 | procedure TForm2.CreateParams(var Params: TCreateParams); 11 | begin 12 | inherited CreateParams(Params); 13 | Params.Style := Params.Style and not WS_OVERLAPPEDWINDOW or WS_BORDER 14 | end; 15 | 16 | 17 | For an MDI child form, setting the BorderStyle to bsNone does NOT remove 18 | the title bar. (This is mentioned in the help). This does it: 19 | 20 | Procedure tMdiChildForm.CreateParams( var Params : tCreateParams ) ; 21 | Begin 22 | Inherited CreateParams( Params ) ; 23 | Params.Style := Params.Style and (not WS_CAPTION) ; 24 | End ; 25 |  -------------------------------------------------------------------------------- /dirs/0044.pas: -------------------------------------------------------------------------------- 1 | 2 | {Hidden Directory Secrets } 3 | program DirHide; 4 | uses dos; 5 | var f: File; 6 | Attr: Word; 7 | 8 | begin 9 | if ParamCount < 1 then 10 | begin 11 | writeln('Usage: DirHide directory'); 12 | Halt 13 | end; 14 | 15 | Assign(f,ParamStr(1)); 16 | GetfAttr(f, Attr); 17 | 18 | if (DosError = 0) AND 19 | ((Attr AND Directory) = Directory) then 20 | begin { v vvvvvvvvv } 21 | Attr := (Attr - Directory) XOR Hidden; { TOGGLE HIDDEN BIT } 22 | SetfAttr(f, Attr); 23 | 24 | if DosError = 0 then 25 | if (Attr AND Hidden) = Hidden then 26 | writeln(ParamStr(1),' hidden') 27 | else 28 | writeln(ParamStr(1),' shown') 29 | end 30 | end. -------------------------------------------------------------------------------- /keyboard/0052.pas: -------------------------------------------------------------------------------- 1 | { 2 | BO KALTOFT 3 | 4 | > How can i disable the Pascal interrupt key Ctrl-Break? 5 | } 6 | 7 | Const 8 | BreakKey : Boolean = False; 9 | BreakOff : Boolean = False; 10 | Var 11 | BreakSave : Pointer; 12 | 13 | {$F+} 14 | Procedure BreakHandler; Interrupt; 15 | begin 16 | BreakKey := True; 17 | end; 18 | {$F-} 19 | 20 | 21 | Procedure CBOff; 22 | begin 23 | GetIntVec($1B, BreakSave); 24 | SetIntVec($1B, Addr(BreakHandler)); 25 | BreakOff := True; 26 | end; 27 | 28 | Procedure CBOn; 29 | begin 30 | SetIntVec($1B, BreakSave); 31 | BreakOff := False; 32 | end; 33 | 34 | begin 35 | BreakSave := Nil; 36 | CBOff; {disable} 37 | . 38 | . 39 | . 40 | CBOn; {enable} 41 | end. 42 | 43 |  -------------------------------------------------------------------------------- /screen/0027.pas: -------------------------------------------------------------------------------- 1 | { 2 | DAVID DRZYZGA 3 | 4 | > I want to know how to get and set the screen colors Without using the 5 | > Crt Unit or ansi codes. Any help is appreciated. 6 | 7 | This will do what you ask. There is no checking of the vidseg since it is 8 | assumed that if you want to Write in color that you are using a color monitor: 9 | } 10 | 11 | Procedure WriteColorAt(X, Y : Byte; St : String; Attr : Byte); 12 | Var 13 | Count : Byte; 14 | begin 15 | For Count := 1 to Length(St) do 16 | begin 17 | Mem[$B800 : 2 * (80 * (Y - 1) + X + Count - 2)] := Ord(St[Count]); 18 | Mem[$B800 : 2 * (80 * (Y - 1) + X + Count - 2) + 1] := Attr; 19 | end; 20 | end; 21 | 22 | begin 23 | WriteColorAt(34, 12, 'Hello World!', $4E); 24 | end. 25 |  -------------------------------------------------------------------------------- /strings/0056.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... StrZero() 3 | * Purpose ....... To return a number as a string with leading zeros 4 | * Parameters .... Num Number to make into a string 5 | * Len Length of resultant string 6 | * Returns ....... as a string, in length with leading zeros 7 | * Notes ......... Uses the functions PadL and ITOS 8 | * Author ........ Martin Richardson 9 | * Date .......... May 13, 1992 10 | *****************************************************************************} 11 | FUNCTION StrZero( Num, Len : LONGINT ) : STRING; 12 | BEGIN 13 | StrZero := PadL( ITOS( Num, 0 ), Len, '0' ); 14 | END; { StrZero } 15 | 16 |  -------------------------------------------------------------------------------- /default.css: -------------------------------------------------------------------------------- 1 | body { 2 | color : Black; 3 | background-color : White; 4 | scrollbar-3dlight-color : #999999; 5 | scrollbar-arrow-color : #999999; 6 | scrollbar-base-color : #666666; 7 | scrollbar-darkshadow-color : Black; 8 | scrollbar-face-color : #666666; 9 | scrollbar-highlight-color : #999999; 10 | scrollbar-shadow-color : #999999; 11 | scrollbar-track-color : #8B8B8B; 12 | font-family : sans-serif; 13 | } 14 | P { 15 | text-indent : 25px; 16 | } 17 | A { 18 | text-decoration: none; 19 | color: blue; 20 | } 21 | A:Hover { 22 | text-decoration: underline; 23 | color: red; 24 | } 25 | A:VISITED { 26 | color : purple; 27 | text-decoration : none; 28 | } 29 | 30 | -------------------------------------------------------------------------------- /delphi/0007.pas: -------------------------------------------------------------------------------- 1 | 2 | Q: How do I use one of the cursor files in the c:\delphi\images\cursors? 3 | 4 | A: Use the image editor to load the cursor into a RES file. 5 | The following example assumes that you saved the cursor in the RES file 6 | as "cursor_1", and you save the RES file as MYFILE.RES. 7 | 8 | (*** BEGIN CODE ***) 9 | {$R c:\programs\delphi\MyFile.res} { This is your RES file } 10 | 11 | const PutTheCursorHere_Dude = 1; { arbitrary positive number } 12 | 13 | procedure stuff; 14 | begin 15 | screen.cursors[PutTheCursorHere_Dude] := LoadCursor(hInstance, 16 | 17 | PChar('cursor_1')); 18 | screen.cursor := PutTheCursorHere_Dude; 19 | end; 20 | 21 | 22 | 23 | 24 |  -------------------------------------------------------------------------------- /delphi/0029.pas: -------------------------------------------------------------------------------- 1 | 2 | The correct usage of TMemo.Lines.GetText() (or any other TString's GetText() 3 | method) is as follows: 4 | 5 | var 6 | lpVar : PChar; 7 | begin 8 | lpVar := Memo.Lines.GetText; 9 | try 10 | {do whatever you like with/to lpVar's contents} 11 | finally 12 | StrDispose(lpVar); 13 | end; 14 | end; 15 | 16 | The GetText method creates a copy of the text in Memo.Lines (or other 17 | TStrings object) via the StrAlloc() function. It is entirely up to 18 | you, the programmer, to dispose of the PChar when you are done via 19 | the StrDispose() function. Since GetText returns a copy of the 20 | text, you can muck about with its contents as you please without 21 | modifying the text in the TMemo. 22 | 23 |  -------------------------------------------------------------------------------- /dos/0063.pas: -------------------------------------------------------------------------------- 1 | 2 | Function FileExists(FileName : string) : boolean; assembler; 3 | { Determines whether the given file exists. Returns true if the file was found, 4 | false - if there is no such file } 5 | Asm 6 | PUSH DS 7 | LDS DX,FileName 8 | INC DX 9 | MOV AX,4300h { get information through the GetAttr function } 10 | INT 21h 11 | MOV AL,False { emulate AL=0 } 12 | JC @@1 13 | INC AL { emulate AL=AL+1=1 } 14 | @@1: 15 | POP DS 16 | End; { FileExists } 17 | 18 | const Found : array[Boolean] of string[10] = ('not found', 'found'); 19 | var FileName : string; 20 | 21 | Begin 22 | Write('Enter file name to search: '); 23 | ReadLn(FileName); 24 | WriteLn('File "', FileName, '" ', Found[FileExists(FileName)], '.'); 25 | End. 26 |  -------------------------------------------------------------------------------- /math/0035.pas: -------------------------------------------------------------------------------- 1 | { Updated NUMBERS.SWG on November 2, 1993 } 2 | 3 | { 4 | JOHN GUILLORY 5 | 6 | > Can someone please show me how I would convert a base 10 number to base 36? 7 | } 8 | 9 | Function BaseChange(Num, NewBase : Word) : String; 10 | Const 11 | BaseChars : Array [0..36] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; 12 | Var 13 | St : String; 14 | begin 15 | St := ''; 16 | Repeat 17 | St := BaseChars[Num MOD NewBase] + St; 18 | Num := Num Div NewBase; 19 | Until Num = 0; 20 | BaseChange := St; 21 | end; 22 | 23 | { 24 | This will convert a number in Base10 (Stored in Orig) to any Base in the 25 | range of 2 through 36 (Please, no base-1's/0's) 26 | } 27 | 28 | begin 29 | Writeln(Basechange(33, 3)); 30 | end. 31 |  -------------------------------------------------------------------------------- /parsing/0004.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... IsSwitch() 3 | * Purpose ....... To test for the presence of a switch on the command line 4 | * Parameters .... sSwitch Switch to scan the command line for 5 | * Returns ....... .T. if the switch was found 6 | * Notes ......... Uses functions Command and UpperCase 7 | * Author ........ Martin Richardson 8 | * Date .......... September 28, 1992 9 | *****************************************************************************} 10 | FUNCTION IsSwitch( sSwitch: STRING ): BOOLEAN; 11 | BEGIN 12 | IsSwitch := (POS( '/'+sSwitch, UpperCase(Command) ) <> 0) OR 13 | (POS( '-'+sSwitch, UpperCase(Command) ) <> 0); 14 | END; 15 |  -------------------------------------------------------------------------------- /screen/0015.pas: -------------------------------------------------------------------------------- 1 | { 2 | A small follow-up to the VGA tricks: 3 | how about a 40x12 Textmode (posted earlier in the Assembler conference): 4 | } 5 | 6 | Procedure Set12x40; Assembler; 7 | Asm 8 | MOV AX, 1 9 | inT $10 { activate 40x25 Text With BIOS } 10 | MOV DX, $03D4 { CrtC } 11 | MOV AL, 9 { maximum scan line register } 12 | OUT DX, AL 13 | inC DX 14 | in AL, DX 15 | or AL, $80 { Double each scan-line bit7 = 1 } 16 | OUT DX, AL 17 | MOV AX, $0040 { set up BIOS data area access } 18 | MOV ES, AX 19 | MOV AL, $0B { BIOS txtlines on 12 = $B +1 } 20 | MOV ES:[$0084], AL { so Programs like QEDIT will work With this } 21 | end; 22 | 23 |  -------------------------------------------------------------------------------- /crt/0004.pas: -------------------------------------------------------------------------------- 1 | { 2 | >> Does anyone know how to clear the screen Really fast ? 3 | >> I'm working in VGA-mode With a resolution of 320*200*256 4 | > You could try a block rewriting of the palettes, but that would probably 5 | > take even longer, since it is usually an interrupt instruction. 6 | 7 | Well, use the standard pascal routine called FillChar. ;-) 8 | } 9 | 10 | FillChar(Mem[$A000:$0000],320*200,0); 11 | 12 | { You can double speed by using 16 bit wide data transfer: } 13 | 14 | Procedure FillChar16(Var X;Count : Word;Value : Byte); Assembler; 15 | Asm 16 | les di,X 17 | mov cd,Count 18 | shr cx,1 19 | mov al,Value 20 | mov ah,al 21 | rep stosw 22 | test Count,1 23 | jz @end 24 | stosb 25 | @end: 26 | end; 27 | 28 |  -------------------------------------------------------------------------------- /delphi/0307.pas: -------------------------------------------------------------------------------- 1 | > 2 | > Does anyone have experience determining the resolution of the default 3 | > printer? At run-time, I don't know what the size of the paper is, 4 | > either. Right now, I have the user enter the resolution manually. This 5 | > has obvous problems. I've tried the DeviceCapabilities() function, but 6 | > delphi can't seem to find it. (I have included both WinTypes and 7 | > WinProcs) the online help shows the syntax for the command, but 8 | > curiously leaves out the function name thus: 9 | 10 | You want GetDeviceCaps() instead, try this: 11 | 12 | var 13 | VertPix, HorzPix : integer ; 14 | begin 15 | VertPix := GetDeviceCaps( Printer.Canvas.Handle,LOGPIXELSX ) ; 16 | HorzPix := GetDeviceCaps( Printer.Canvas.Handle,LOGPIXELSY ) ; 17 | 18 |  -------------------------------------------------------------------------------- /drives/0076.pas: -------------------------------------------------------------------------------- 1 | { 2 | -=> Quoting Christian Proehl to All <=- 3 | 4 | CP> Subject: Disk-detecting routines without DOS (and 5 | 6 | CP> Muelheim, den 20.05.94 7 | 8 | CP> Hello! 9 | 10 | CP> I have problem I don't know how to solve it. 11 | CP> Perhaps someone around the world knows more, please help me! 12 | 13 | use the bios call 14 | 15 | function $16, int $13 16 | } 17 | 18 | function DiskChange( DriveNmber :Byte) :Boolean; 19 | Begin 20 | ASm 21 | Mov AH, $16 22 | Mov DL, driveNmber 23 | Int $13 24 | Mov AL,AH; { use AL & AH as a Return Value } 25 | End; 26 | End; 27 | 28 | Begin 29 | If DiskChange(0) then Write(' Disk has Changed in Drive ''A'' ') 30 | Else 31 | Write(' Disk Has changed '); 32 | end. 33 |  -------------------------------------------------------------------------------- /faq/0032.pas: -------------------------------------------------------------------------------- 1 | { 2 | ldeboer@cougar.multiline.com.au (Leon DeBoer) 3 | 4 | { 5 | : At first I had a problem with tp7's inline assemble: I had an 6 | : array[0..4] of word in my unit, and I wanted to access it's elements 7 | : from inline assemble. I got it working like this 8 | 9 | Try 10 | } 11 | 12 | Asm 13 | MOV AX, SEG MyArray; { Segment of array } 14 | MOV DS, AX; 15 | MOV SI, OFFSET MyArray; 16 | MOV AX, DS:[SI]+0; {Element 0 in array } 17 | MOV AX, DS:[SI]+2; { Element 1 in array etc } 18 | End; 19 | 20 | 21 | 22 | { 23 | Note from SWAG Team: 24 | 25 | From now on, all ASM/TASM/BASM Specific info (that don't fit in any 26 | other category), will be placed in FAQ.SWG instead of MISC.FAQ 27 | 28 | - Kerry 29 | } -------------------------------------------------------------------------------- /files/0002.pas: -------------------------------------------------------------------------------- 1 | { 2 | JOE DICKSON 3 | 4 | > I was wondering if someone could tell me how to change the Time and Date 5 | > and maybe the Attribute of a File? Lets say I want to Change: 6 | > FileNAME.EXT 1024 01-24-93 12:33p A to: 7 | > FileNAME.EXT 1024 01-01-93 01:00a AR 8 | } 9 | 10 | Program change_sample_Files_attribs; 11 | 12 | Uses 13 | Dos; 14 | 15 | Var 16 | f : File; 17 | attr : Word; 18 | time : LongInt; 19 | DT : datetime; 20 | 21 | begin 22 | assign(f, 'FileNAME.EXT'); 23 | DT.year := 93; 24 | DT.month := 1; 25 | DT.day := 1; 26 | dt.hour := 1; 27 | dt.min := 0; 28 | dt.sec := 0; 29 | packtime(dt, time); 30 | attr := ReadOnly; 31 | setftime(f, time); 32 | setfattr(f, attr); 33 | end. 34 |  -------------------------------------------------------------------------------- /numbers/0010.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I need to transfer decimal into binary using TURBO PASCAL. 3 | > One way to do this is to use the basic algorithm, dividing 4 | > by 2 over and over again. if the remainder is zero the 5 | > bit is a 0, else the bit is a 1. 6 | > 7 | > However, I was wondering if there is another way to convert 8 | > from decimal to binary using PASCAL. Any ideas? 9 | 10 | As an 8-bit (ie. upto 255) example... 11 | } 12 | 13 | Function dec2bin(b:Byte) : String; 14 | Var bin : String[8]; 15 | i,a : Byte; 16 | begin 17 | a:=2; 18 | For i:=8 downto 1 do 19 | begin 20 | if (b and a)=a then bin[i]:='1' 21 | else bin[i]:='0'; 22 | a:=a*2; 23 | end; 24 | dec2bin:=bin; 25 | end; 26 | 27 |  -------------------------------------------------------------------------------- /screen/0039.pas: -------------------------------------------------------------------------------- 1 | { 2 | SEAN PALMER 3 | 4 | > Does anyone have any quick Procedures For detecting the number of 5 | > lines as passed through the Dos "MODE" command? Ie, 25 lines, 43 or 50 6 | > line mode? This way, when Programming a door, I can place the status 7 | > line on the correct area of screen. 8 | 9 | Try this, anything that correctly updates the bios when it changes modes 10 | should be reported correctly. 11 | } 12 | 13 | Var 14 | rows : Byte; 15 | 16 | Function getRows : Byte; Assembler; 17 | Asm 18 | mov ax, $1130 19 | xor dx, dx 20 | int $10 21 | or dx, dx 22 | jnz @S {cga/mda don't have this fn} 23 | mov dx, 24 24 | @S: 25 | inc dx 26 | mov al, dl 27 | end; 28 | 29 | begin 30 | writeln(getrows); 31 | end. 32 |  -------------------------------------------------------------------------------- /strings/0006.pas: -------------------------------------------------------------------------------- 1 | Function Spaces(NumSpaces : Byte) : String; 2 | 3 | Var 4 | s : String; 5 | 6 | begin 7 | s[0] := Chr(Numspaces); 8 | If NumSpaces = 0 Then 9 | Exit; 10 | FillChar(s[1], NumSpaces, ' '); 11 | Spaces := s; 12 | end; 13 | 14 | { 15 | This still too slow For my taste, though... there's a superfluous String 16 | copy and it still needs 512 Bytes of stack space. 17 | } 18 | 19 | Function Spaces(NumSpaces : Byte) : String; Assembler; 20 | 21 | Asm 22 | LES DI, @Result 23 | CLD 24 | MOV AL, NumSpaces 25 | xor AH, AH 26 | STOSB 27 | XCHG AX, CX 28 | JCXZ @Exit 29 | MOV AL, ' ' 30 | SHR CX, 1 31 | JNC @Even 32 | STOSB 33 | @Even: REP STOSW 34 | @Exit: 35 | end; { Spaces } 36 |  -------------------------------------------------------------------------------- /strings/0034.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... GetMask() 3 | * Purpose ....... To return the mask from a path/mask string 4 | * Parameters .... Path String to extract the mask from 5 | * Returns ....... The file mask portion of 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | TYPE 11 | String13 = STRING[13]; 12 | FUNCTION GetMask( Path: DirStr ): String13; 13 | VAR dir : DirStr; 14 | name : NameStr; 15 | ext : ExtStr; 16 | BEGIN 17 | FSPLIT( path, dir, name, ext ); 18 | GetMask := name + ext; 19 | END; 20 | 21 |  -------------------------------------------------------------------------------- /delphi/0056.pas: -------------------------------------------------------------------------------- 1 | 2 | The first point I would make is that you went to an awful lot of trouble 3 | to implement the WinExec API call... cleaner code would look like: 4 | 5 | begin 6 | winexec('C:\Program.exe', SW_SHOWNORMAL); 7 | end; 8 | 9 | Delphi automatically treats this as a null-terminated string (like c). As 10 | to the answer to your question. WinExec returns a handle to the 11 | task. Simply do the following: 12 | 13 | procedure SomeProc; 14 | var 15 | ProgramHandle : THandle; 16 | begin 17 | ProgramHandle := WinExec('C:\Program.exe', SW_SHOWNORMAL); 18 | while GetModuleusage(ProgramHandle) <> 0 do application.processmessages; 19 | {The above line will loop until the program terminates} 20 | {continue on with program below here} 21 | end; 22 |  -------------------------------------------------------------------------------- /drives/0039.pas: -------------------------------------------------------------------------------- 1 | { 2 | ROB GREEN 3 | 4 | > do any of you guys know how to figure out which drive is the last drive 5 | > on someone's system? I was think of making a drive With Dos's 6 | } 7 | 8 | Uses 9 | Dos; 10 | 11 | Function driveexist(ch : Char) : Boolean; 12 | begin 13 | DriveExist := disksize(ord(upcase(ch)) - 64) <> - 1; 14 | end; 15 | 16 | 17 | { Kerry Sokalsky } 18 | 19 | Const 20 | exist : Boolean = True; 21 | ch : Integer = 67; { 'C' - Skip floppy Drives (A&B) } 22 | lastdrive : Char = ' '; 23 | 24 | begin 25 | While LastDrive = ' ' do 26 | begin 27 | if driveexist(Chr(ch)) then 28 | Inc(Ch) 29 | else 30 | LastDrive := Chr(Ch - 1); 31 | end; 32 | 33 | Writeln(LastDrive); 34 | end. 35 | 36 |  -------------------------------------------------------------------------------- /drives/0041.pas: -------------------------------------------------------------------------------- 1 | {***************************************************************************** 2 | * Function ...... BytesPerSector() 3 | * Purpose ....... To return the number of bytes per sector of a disk 4 | * Parameters .... nDrive Drive containing disk 5 | * Returns ....... The number of bytes per sector of the specified disk 6 | * Notes ......... None 7 | * Author ........ Martin Richardson 8 | * Date .......... May 13, 1992 9 | *****************************************************************************} 10 | FUNCTION BytesPerSector( nDrive: BYTE ): INTEGER; 11 | VAR 12 | Regs: Registers; 13 | BEGIN 14 | Regs.AH := $1C; 15 | Regs.DL := nDrive; 16 | MSDOS( Regs ); 17 | BytesPerSector := Regs.AL * Regs.CX; 18 | END; 19 | 20 |  -------------------------------------------------------------------------------- /drives/0074.pas: -------------------------------------------------------------------------------- 1 | { 2 | Q: How do I detect, a certain drive is a CD-Rom? 3 | 4 | A: The foolowing function returns True if the drive is a CD-ROM. 5 | } 6 | 7 | Uses DOS; 8 | FUNCTION Is_CDROM(Drv : Char):BOOLEAN; 9 | VAR R : Registers; 10 | CDR: string; 11 | cnt: byte; 12 | BEGIN 13 | Is_CDROM := false; 14 | CDR := ''; 15 | WITH R DO 16 | BEGIN 17 | AX := $1500; 18 | BX := $0000; 19 | CX := $0000; 20 | Intr( $2F, R ); 21 | IF BX > 0 THEN 22 | BEGIN 23 | FOR cnt := 0 TO (bx-1) DO 24 | CDR := CDR +CHAR( CL + Byte('A') + cnt ); 25 | END; 26 | Is_CDROM := POS( upcase(Drv), CDR ) > 0 27 | END 28 | END; 29 |  -------------------------------------------------------------------------------- /interrup/0003.pas: -------------------------------------------------------------------------------- 1 | Okay, well, For the most part, calling an interrupt from TP is fairly 2 | simple. I'll use Interrupt 10h (service 0) as an example: 3 | 4 | Procedure CallInt; 5 | Var 6 | Regs : Registers; 7 | begin 8 | Regs.AH := 0; { Specify service 0 } 9 | Regs.AL := $13; { Mode number = 13 hex, MCGA 320x200x256 } 10 | Intr($10,Regs); { Call the interrupt } 11 | end; 12 | 13 | This would shift the screen to the MCGA Graphics mode specified. Now, 14 | it's easier to call this in BAsm (built-in Assembler): 15 | 16 | Procedure CallInt; Assembler; 17 | Asm 18 | MOV AH,0 { Specify service 0 } 19 | MOV AL,13h { Mode number = 13 hex, MCGA 320x200x256 } 20 | inT 10h { Call the interrupt } 21 | end; 22 | 23 |  -------------------------------------------------------------------------------- /memory/0023.pas: -------------------------------------------------------------------------------- 1 | { JOACHIM BARTZ } 2 | 3 | Function CompBlocks(Buf1, Buf2 : Pointer; 4 | BufSize : Word) : Boolean; Assembler; 5 | Asm { Compares two buffers and returns True if contents are equal } 6 | PUSH DS 7 | MOV AX,1 { Init error return: True } 8 | LDS SI,Buf1 9 | LES DI,Buf2 10 | MOV CX,BufSize 11 | JCXZ @@Done 12 | CLD { Loop Until different or end of buffer } 13 | REP CMPSB { Flag to bump SI,DI } 14 | JE @@Done 15 | { Compare error } 16 | XOR AX, AX { Return False } 17 | @@Done: 18 | POP DS { Restore } 19 | end; 20 |  -------------------------------------------------------------------------------- /datetime/0046.pas: -------------------------------------------------------------------------------- 1 | { 2 | > I want to know if it's possible to get the BIOS Serial number and how to 3 | > get it in pascal. 4 | 5 | I dunno about BIOS serial number, i know how to get a BIOS date, thats true. 6 | Here's the source (that is also welcome to place in SWAG): 7 | } 8 | 9 | Function GetBiosDate : string; assembler; 10 | Asm 11 | push ds 12 | {$IFDEF DPMI} { look, it works with DPMI too } 13 | mov ax,2 14 | mov bx,0FFFFh 15 | int 31h 16 | {$ELSE} 17 | mov ax,0FFFFh 18 | {$ENDIF} 19 | mov ds,ax 20 | mov si,0005h 21 | les di,@Result 22 | cld 23 | mov ax,8 24 | stosb 25 | mov cx,ax 26 | rep movsb 27 | pop ds 28 | End; { GetBiosDate } 29 | 30 | Begin 31 | WriteLn('BIOS date: ', GetBiosDate) { Simple, eh? } 32 | End. 33 |  -------------------------------------------------------------------------------- /dirs/0056.pas: -------------------------------------------------------------------------------- 1 | 2 | Program TouchDir; 3 | 4 | Uses Dos; 5 | 6 | Var S:SearchRec; 7 | F:Text; 8 | H,M,S,Hund:Word; 9 | DOW,Year,Month,Day:Word; 10 | FTime:LongInt; 11 | DT:DateTime; 12 | Dir:String; 13 | 14 | Begin 15 | If ParamCount = 0 Then 16 | Begin 17 | Writeln('Usage: TOUCHDIR '); 18 | Halt; 19 | End; 20 | FindFirst(Dir,Directory,S); 21 | If DosError = 0 Then 22 | Begin 23 | Assign(F,Dir); 24 | GetTime(H,M,S,Hund); 25 | GetDate(Year,Month,Day,DOW); 26 | DT.Hour:=H; 27 | DT.Min:=M; 28 | DT.Sec:=S; 29 | DT.Year:=Year; 30 | DT.Month:=Month; 31 | DT.Day:=Day; 32 | PackTime(DT,FTime); 33 | SetFTime(F,FTime); 34 | Writeln('Touched the ',Dir,' directory.'); 35 | End 36 | End. 37 | 38 |  -------------------------------------------------------------------------------- /keyboard/0071.pas: -------------------------------------------------------------------------------- 1 | { 2 | From: MAYNARD PHILBROOK 3 | Subj: Re: keyboard buffer 4 | --------------------------------------------------------------------------- 5 | TH> How do you write TO the keyboard buffer. 6 | TH> I need a routine that will put a string into the keyboard buffer then 7 | TH> exit to the calling program leaving the key buffer full. 8 | TH> This is to simulate a macro function for a menu program. 9 | } 10 | function PushIntoKeyBoard( c:char; ScanCode:Byte):boolean; 11 | Begin 12 | asm 13 | Mov Ah, 05h 14 | Mov Ch, ScanCode; 15 | Int $16; 16 | Mov @result, Al; { Results } 17 | End; 18 | Result := Not(Result); 19 | End; 20 | 21 | {returns true if Buffer took it other wise it mite be full or Not Supported} 22 |  -------------------------------------------------------------------------------- /pointers/0008.pas: -------------------------------------------------------------------------------- 1 | { 2 | Authors: Chet Kress and Jerome Tonneson 3 | 4 | >Help !!! I need a Function or Procedure in standard pascal that will 5 | >calculate the height of a binary tree. It must be able to calculate the 6 | >height of the tree if the tree is either balanced, unbalanced or full. 7 | >The Procedure must be recursive. 8 | 9 | Here are the only two Functions you will need. 10 | } 11 | 12 | Function Max(A, B : Integer) : Integer; 13 | begin {Max} 14 | If A > B then 15 | Max := A; 16 | else 17 | Max := B; 18 | end; {Max} 19 | 20 | Function Height (Tree : TreeType) : Integer; 21 | begin {Height} 22 | If Tree = Nil then 23 | Height := 0 24 | else 25 | Height := Max(Height(Tree^.Right), Height(Tree^.Left)) + 1; 26 | end; {Height} 27 |  -------------------------------------------------------------------------------- /entry/0030.pas: -------------------------------------------------------------------------------- 1 | 2 | var i : word; 3 | 4 | { Simple error checking } 5 | function Getnbr1 (msg:string) : word; 6 | var w : word; 7 | begin 8 | repeat 9 | write(msg); 10 | {$I-} readln(w); {$I+} 11 | until ioresult=0; 12 | Getnbr1 := w; 13 | end; 14 | 15 | { fancier error checking } 16 | function Getnbr2 (msg:string) : word; 17 | var x : longint; 18 | s : string; 19 | w : word; 20 | i : integer; 21 | begin 22 | repeat 23 | write(msg); 24 | readln(s); 25 | val(s,x,i); 26 | until (i=0) and (x>=0) and (x<=65535); 27 | getnbr2 := x; 28 | end; 29 | 30 | begin 31 | i := getnbr1('Please enter a number? '); writeln(i); 32 | i := getnbr2('Please enter a number? '); writeln(i); 33 | end. 34 |  -------------------------------------------------------------------------------- /sorting/0004.pas: -------------------------------------------------------------------------------- 1 | { 2 | > Does anyone know of a routine or code that would allow For a 3 | > alphabetical sort? 4 | 5 | Depends on what Type of sorting you want to do- For a very small list, a 6 | simple BubbleSort will suffice. 7 | } 8 | Const 9 | max = 50; 10 | Var 11 | i,j:Integer; 12 | a : Array[1..max] of String; 13 | temp : String; 14 | begin 15 | For i := 1 to 50 do 16 | For j := 1 to 50 do 17 | if a[i] < a[j] then 18 | begin 19 | temp := a[i]; 20 | a[i] := a[j]; 21 | a[j] := temp; 22 | end; { if } 23 | end. 24 | 25 | { 26 | If it's a bigger list than, say 100 or so elements, or it needs to be 27 | sorted often, you'll probably need a better algorithm, like a shell sort 28 | or a quicksort. 29 | } 30 | 31 |  -------------------------------------------------------------------------------- /datetime/0055.pas: -------------------------------------------------------------------------------- 1 | {From: Scott Stone } 2 | 3 | Procedure CompTimes(t1,t2 : string); 4 | Var 5 | h1,h2,m1,m2,s1,s2 : string; 6 | x0,x1,x2,x3,x4,x5,sec0,sec1 : integer; 7 | err : integer; 8 | timediff : integer; 9 | Begin 10 | h1:=t1[1]+t1[2]; 11 | h2:=t2[1]+t2[2]; 12 | m1:=t1[4]+t1[5]; 13 | m2:=t2[4]+t2[5]; 14 | s1:=t1[7]+t1[8]; 15 | s2:=t2[7]+t2[8]; 16 | val(h1,x0,err); 17 | val(h2,x1,err); 18 | val(m1,x2,err); 19 | val(m2,x3,err); 20 | val(s1,x4,err); 21 | val(s2,x5,err); 22 | sec0:=((3600*x0)+(60*x2)+(x4)); 23 | sec1:=((3600*x1)+(60*x3)+(x5)); 24 | timediff:=abs(sec1-sec0); 25 | writeln('Time Difference is ',timediff,' seconds.'); 26 | End; 27 | 28 | begin 29 | CompTimes('11:23:31','16:32:21'); 30 | end. -------------------------------------------------------------------------------- /delphi/0227.pas: -------------------------------------------------------------------------------- 1 | 2 | function RegGetStr( sKey, sItem, sDefVal : string ) : string; 3 | var 4 | reg : TRegIniFile; 5 | begin 6 | reg := TRegIniFile.Create( sKey ); 7 | Result := reg.ReadString( '', sItem, sDefVal ); 8 | reg.Free; 9 | end; 10 | 11 | procedure RegSetStr( sKey, sItem, sVal : string ); 12 | var 13 | reg : TRegIniFile; 14 | begin 15 | reg := TRegIniFile.Create( sKey ); 16 | reg.WriteString( '', sItem, sVal + #0 ); 17 | reg.Free; 18 | end; 19 | 20 | // now, you can call above helper functions like you wanted: 21 | // 22 | 23 | {ATextBox.Text :=3D RegGetStr( 'Software\MyCompanyName\MyProductName', 24 | 'variable1', 'default value goes here' ); 25 | 26 | RegSetStr( 'Software\MyCompanyName\MyProductName', 'variable1', 27 | ATextBox.Text );} 28 | 29 |  -------------------------------------------------------------------------------- /keyboard/0121.pas: -------------------------------------------------------------------------------- 1 | 2 | Unit Toggle; 3 | {$O+} 4 | 5 | interface 6 | 7 | type 8 | BytePtr = ^Byte; 9 | 10 | const 11 | _ScrollLock = $10; 12 | _NumLock = $20; 13 | _CapsLock = $40; 14 | _InsertKey = $80; 15 | 16 | procedure KeyboardToggle ( Mask : byte ); 17 | 18 | implementation 19 | 20 | (* To use this procedure, just pass along the constants that you want 21 | toggled. For example. To toggle the Scroll Lock and Caps Lock you 22 | would call: 23 | KeyBoardToggle(_ScrollLock + _CapsLock); 24 | *) 25 | 26 | procedure KeyboardToggle ( Mask : byte ); 27 | var 28 | KeyBoardStatus : BytePtr; 29 | begin 30 | KeyBoardStatus := Ptr($0000,$0417); 31 | KeyBoardStatus^ := KeyBoardStatus^ xor Mask; 32 | end; 33 | 34 | end. 35 |  --------------------------------------------------------------------------------