SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00082 DISK DRIVE HANDLING ROUTINES 1 05-28-9313:38ALL NORBERT IGL Unit to access CDROM IMPORT 124 ╣Φƒ {π> Are there anybody out there who has some routins to play CD Audio in a CDπ> ROM drive. Just the usual commands like play, stop, resume, eject and soπ> on. I would appreciate any help!π}ππUnit CDROM;ππ{ Unit talking to a CD-Rom-Driveπ Low-level CD access,π only the first drive is supported...!π Copyright 1992 Norbert Igl }ππInterfaceππTypeπ CD_Record = Recordπ Status : Word; { Status des Drives/letzte Funktion }π DrvChar: Char; { LW-Buchstabe }π DrvNo : Byte; { als Byte ablegegt (0...) }π HSG_RB : Byte; { Adressierungs-Modus }ππ Sector : LongInt; { Adresse des Lesekopfes }π VolInfo: Array[1..8] of Byte; { Lautst.-Einstellungen }π DevPar : LongInt; { Device-parameter, BIT-Feld! }π RawMode: Boolean; { Raw/Cooked-Mode ? }π SecSize: Word; { Bytes/Sector }π VolSize: LongInt; { sek/Volume => Groesse der CD}ππ MedChg : Byte; { Disk gewechselt? }ππ LoAuTr : Byte; { kleinste Audio-Track # }π HiAuTr : Byte; { groesste Audio-Track # }π endAdr : LongInt; { Adresse der Auslaufrille (8-) }ππ TrkNo : Byte; { Track #. Eingabe-Wert ! }π TrkAdr : LongInt; { Adresse dieses Tracks }π TrkInf : Byte; { Info dazu: BIT-Feld! }ππ CntAdr : Byte; { CONTROL und ADR, von LW }π CTrk : Byte; { track # }π Cindx : Byte; { point/index }π CMin : Byte; { minute\ }π CSek : Byte; { second > Laufzeit im Track }π CFrm : Byte; { frame / }π Czero : Byte; { immer =0 }π CAmin : Byte; { minute \ }π CAsec : Byte; { sekunde > Laufzeit auf Disk }π CAFrm : Byte; { frame / }ππ Qfrm : LongInt;{ start-frame address }π Qtrfs : LongInt;{ Bufferaddresse }π Qcnt : LongInt;{ Anzahl der Sectoren }π { pro Sector werden 96 Byte nach buffer kopiert }ππ Uctrl : Byte; { CONTROL und ADR Byte }π Upn : Array[1..7] of Byte; { EAN-CODE }π Uzero : Byte; { immer = 0 }π Ufrm : Byte; { Frame-# }π end;π OneTrack = Recordπ Title : String[20];π Runmin,π RunSec : Byte;π Start : LongInt; { HSG Format ! }π end;π VolumeTableOfContens = Recordπ Diskname: String[20];π UAN_Code: String[13];π TrackCnt: Byte;π Titles : Array[1..99] of OneTrack;π end;π TrkInfo = Recordπ Nummer : Byte;π Start : LongInt;π Cntrl2 : Byte;π end;π{===== global verfuegbare Variablen =============}ππVar CD : CD_Record;π CD_AVAIL : Boolean;π VtoC : VolumeTableOfContens;π CD_REDPos : String;π CD_HSGPos : String;ππ{===== allgemeine Funktionen ===================}ππFunction CD_Reset : Boolean;πFunction CD_HeadAdr : Boolean;πFunction CD_Position: Boolean;πFunction CD_MediaChanged: Boolean;πππ{===== Tray/Caddy-Funktionen ===================}ππFunction CD_Open: Boolean;πFunction CD_Close: Boolean;πFunction CD_Eject: Boolean;ππ{==== Audio-Funktionen =========================}ππFunction CD_Play(no:Byte; len:Integer): Boolean;πFunction CD_Stop: Boolean;πFunction CD_Resume:Boolean;πFunction CD_SetVol:Boolean;πFunction CD_GetVol:Boolean;ππProcedure CD_Info;πProcedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );ππ{==== Umwandlungen =============================}ππFunction Red2Time( Var Inf:TrkInfo ):Word;ππImplementation Uses Dos;πType IOCtlBlk = Array[0..200] of Byte;ππConst IOCtlRead = $4402;π IOCtlWrite = $4403;π DevDrvReq = $1510;π All:LongInt= $0f00;ππVar R : Registers;π H : Text;π Handle : Word;π Old_Exit : Pointer;π CtlBlk : IOCtlBlk;ππ Tracks : Array[1..100] of TrkInfo;ππProcedure CD_Exit; { wird bei Programmende ausgefuehrt }πbeginπ if Old_Exit <> NILπ then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }π{$I-}π Close(H);π If IoResult = 0 then; { 'H' schliessen, falls offen, }π{$I+} { evtl. Fehler verwerfen }πend;πππFunction CD_Init: Boolean; { Initialisierung beim Programmstart }πbeginπ FillChar( CD, SizeOf( CD ), 0);π With R doπ beginπ AX := $1500;π BX := $0000;π CX := $0000;π Intr( $2F, R );π CD_Init := (BX > 0); { Anzahl der CD-Laufwerke }π If BX > 0π then beginπ CD.DrvChar { CD-Laufwerksbuchstabe }π := Char( CL + Byte('A') );π CD.DrvNo := CL;π If CD_HeadAdr thenπ If CD_GetVol then;π endπ else CD.DrvChar := '?'; { im Fehlerfall...}π endπend;ππProcedure CD_TrackInfo( Nr:Byte; Var T:TrkInfo );πbeginπ T := Tracks[nr]πend;ππFunction OpenCDHandle:Word;πConst Name : String[8] = 'MSCD001'; { evt. anpassen!!! ? }πbeginπ Assign(H, Name); { Filehandle holen }π(*$I-*)π Reset(H);π(*$I+*)π if IoResult = 0 thenπ beginπ Handle := TextRec(H).Handle; { Filehandle holen }π Old_Exit := ExitProc; { Bei ende/Abbruch muss 'H'... }π ExitProc := @CD_Exit; { ...automatisch geschlossen werden }π endπ else Handle := 0;π OpenCDHandle := Handle;πend;ππProcedure CloseCDHandle;πbeginπ if TextRec(H).Mode <> FmClosedπ then ExitProc := Old_Exit; { Umleitung wieder zuruecknehmen }π Old_Exit := NIL;π{$I-}π Close(H);π If IoResult = 0 then; { 'H' schliessen, falls offen, }π{$I+} { evtl. Fehler verwerfen }πend;πππFunction Red2HSG( Var Inf:TrkInfo ):LongInt;πVar l: LongInt;πbeginπ l := LongInt(( Inf.Start shr 16 ) and $FF ) * 4500;π l := l + LongInt(( Inf.Start shr 8 ) and $FF ) * 75;π l := l + LongInt(( Inf.Start ) and $FF ) ;ππ Red2HSG := l -2;πend;ππFunction Red2Time( Var Inf:TrkInfo ):Word;πbeginπ Red2Time:= (( Inf.Start shr 24 ) and $FF ) shl 8π + (( Inf.Start shr 16 ) and $FF )πend;ππFunction HSG2Red(L:LongInt):LongInt;πbeginπend;ππFunction CD_IOCtl( Func, Len : Word) : Boolean;πbeginπ With R doπ beginπ AX := Func;π BX := OpenCDHandle;π CX := 129;π DS := DSeg;π ES := DS;π DX := Ofs(CtlBlk);π MsDos( R );π CD.Status := AX;π CD_IOCtl := (Flags and FCARRY) = 0;π CloseCDHandle;π endπend;πππFunction CD_Reset: Boolean;πbeginπ CtlBlk[0] := 2; { Reset }π CD_Reset := CD_IoCtl( IoCtlWrite, 1)πend;ππFunction DieTuer( AufZu:Byte ): Boolean;πbeginπ CtlBlk[0] := 1; { die Tuer.. }π CtlBlk[1] := AufZu; { ..freigeben }π DieTuer := CD_IoCTL(IoCtlWrite, 2);πend;ππFunction CD_Open: Boolean;πConst Auf = 0;πbeginπ CD_Open := DieTuer( Auf );πend;ππFunction CD_Close: Boolean;πConst Zu = 1;πbeginπ CD_Close := DieTuer( Zu );πend;πππFunction CD_Eject: Boolean;πbeginπ CtlBlk[0] := 0; { CD auswerfen }π CD_Eject := CD_IOCtl(IoCtlWrite, 1);πend;πππFunction CD_Play(no:Byte; len:Integer): Boolean;πbegin { CD PlayAudio }ππ FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 22; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $84; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π CtlBlk[5] := 0;π CtlBlk[13]:= CD.HSG_RB; { HSG-Modus }ππ CD.Sector := VtoC.Titles[no].Start; { ist im HSG-Format }ππ Move( CD.Sector, CtlBlk[14], 4 ); { Start-Sector }π if len = -1π then All := $FFFFπ else All := len;π Move( All , CtlBlk[18], 4 ); { Anzahl Sectoren}π Asmπ mov ax, $1510π push dsπ pop esπ xor cx, cxπ mov cl, CD.DrvNoπ mov bx, offset CtlBlkπ Int $2fπ end;ππ CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Play := CD.Status and $8000 = 0;ππend;ππFunction CD_VtoC:Boolean;πVar i: Byte;π l: LongInt;πbeginπ FillChar( Tracks, SizeOf( Tracks ), 0);π CtlBlk[0] := 10; { Read LeadOut-Tr }π CD_IoCtl( IoCtlRead, 6);π Move( CtlBlk[1], CD.LoAuTr, 6);π i := CD.HiAuTr+1;π Move( CtlBlk[3], Tracks[i], 4); { die Auslaufrille 8-) }π Tracks[i].Start := Red2Hsg(Tracks[i]);ππ For i := CD.LoAuTr to CD.HiAuTr doπ beginπ FillChar(CtlBlk, SizeOf(CtlBlk), 0); { RED-Book-Format }π CtlBlk[0] := 11; { Read VtoC-Entry }π CtlBlk[1] := i; { track-no }π CD_IoCtl( IoCtlRead, 6);π Move( CtlBlk[1], Tracks[i], 6);π{ Tracks[i].Start := Red2Hsg(Tracks[i]); }π end;πππ With VtoC doπ beginπ DiskName := '';π UAN_Code := '';π TrackCnt := CD.HiAuTr;π For i := CD.LoAuTr to CD.HiAuTr doπ With Titles[i] doπ beginπ L := LongInt((Tracks[i+1].Start shr 16) and $FF) * 60π + (Tracks[i+1].Start shr 8) and $FFπ - ( LongInt((Tracks[i].Start shr 16) and $FF) * 60π + (Tracks[i].Start shr 8) and $FF);π Title := '???';π RunMin := L div 60;π RunSec := l - RunMin*60;π Start := Red2Hsg(Tracks[i]);π endπ end;ππππend;ππFunction CD_Stop: Boolean;πbegin { CD StopAudio }π FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 5; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $85; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π CtlBlk[5] := 0;π Asmπ mov ax, $1510π push dsπ pop esπ xor cx, cxπ mov cl, CD.DrvNoπ mov bx, offset CtlBlkπ Int $2fπ end;ππ CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Stop := CD.Status and $8000 = 0;ππend;πππFunction CD_Resume:Boolean;πbegin { ResumeAudio}π CtlBlk[0] := 3; { laenge des req-hdr }π CtlBlk[1] := 0; { sub-Unit }π CtlBlk[2] := $88; { Kommando }π CtlBlk[3] := 0; { Status-WORT }π CtlBlk[4] := 0;π Asmπ mov ax, Seg @DATAπ mov es, axπ mov ax, DevDrvReqπ lea bx, CtlBlkπ Int 2fhπ end;π CD.Status := CtlBlk[3] or CtlBlk[4] shl 8;π CD_Resume := CD.Status and $8000 = 0;ππend;ππFunction CD_GetVol:Boolean;πbeginπ CtlBlk[0] := 4; { die Lautstaerke lesen }π CD_GetVol := CD_IOCtl(IoCtlRead, 8);π if ((R.Flags and FCARRY) = 0)π then Move(CtlBlk[1], CD.VolInfo, 8)π else FillChar( CD.VolInfo, 8, 0)πend;ππFunction CD_SetVol:Boolean;πbeginπ CtlBlk[0] := 3; { die Lautstaerke setzen }π CD_SetVol := CD_IOCtl( IoCtlWrite, 8);πend;ππFunction CD_HeadAdr: Boolean;πVar L:LongInt; S:String;πbeginπ FillChar(CtlBlk, SizeOf(CtlBlk), 0);π CtlBlk[0] := 1;π CtlBlk[1] := 1; { die KopfPosition im RED-Format }π CD_HeadAdr:= CD_IOCtl(IoCtlRead, 128);π if ((R.Flags and FCARRY) = 0)π then beginπ Move(CtlBlk[2], L, 4);π if CtlBlk[1] = 1 thenπ beginπ STR( CtlBlk[4]:2, S); CD_REDPos := S;π STR( CtlBlk[3]:2, S); CD_REDPos := CD_REDPos+ ':'+ S;π CD.Sector := LongInt(CtlBlk[4]) *4500 +π LongInt(CtlBlk[3]) *75 +π LongInt(CtlBlk[2])π - 150;π end elseπ beginπ CD.Sector := L;π STR(L:0,CD_HSGPos);π endππ endπ else FillChar( CD.Sector, 4, 0);πend;πππFunction CD_Position:Boolean;πVar l : LongInt;πbeginπ CtlBlk[0] := 12; { Audio-Infos }π CD_Position :=CD_IOCtl(IoCtlRead,10);π Move(CtlBlk[1], CD.CntAdr, 10);πend;πππProcedure CD_GetUAN;πbeginπ CtlBlk[0] := 14; { EAN-Nummer }π If CD_IOCtl(IoCtlRead,10)π then Move(CtlBlk[1], CD.Uctrl, 10);πend;πππFunction CD_MediaChanged:Boolean;πbeginπ CtlBlk[0] := 9; { Media-Change }π If CD_IOCtl(IoCtlRead, 1)π then Move(CtlBlk[1], CD.MedChg, 1 );π CD_MediaChanged:= CD.MedChg <> 1πend;ππProcedure CD_Info;πbeginππ { CD_Reset; }ππ If CD_HeadAdr then;ππ CtlBlk[0] := 6; { Device-parameter }π If CD_IOCtl(IoCtlRead, 4)π then Move(CtlBlk[1], CD.DevPar, 4 );ππ CtlBlk[0] := 7; { Sector-Groesse }π If CD_IOCtl(IoCtlRead, 3) { & Modus }π then Move(CtlBlk[1], CD.RawMode, 3 );ππ CtlBlk[0] := 8; { Volume-Groesse }π If CD_IOCtl(IoCtlRead, 4)π then Move(CtlBlk[1], CD.VolSize, 4 );ππ CtlBlk[0] := 12; { Audio-Infos }π If CD_IOCtl(IoCtlRead,10)π then Move(CtlBlk[1], CD.CntAdr, 10);ππ CtlBlk[0] := 11; { Track-Infos }π CtlBlk[1] := CtlBlk[2]; { aktueller... }π If CD_IOCtl(IoCtlRead, 6)π then Move(CtlBlk[1], CD.TrkNo, 6 );ππ CD_VtoC;ππend;ππ{========= minimale Initialisierung =============}πbeginπ CD_Avail := CD_Init;π if CD_Avail then CD_INFOπend. Norbertππ{π--- part 2, a Test -----π}πProgram CDROM_TEST;πUses Crt, cdrom, SbTest;πType a5 = Array[0..4] of Byte;πVar i:Byte;π L : LongInt;π ch : Char;π no,π len : Integer;ππbeginπ ClrScr;π WriteLn('CDROM-Unit TestProgram',#10);π With CD doπ if CD_Avail thenπ beginπ WriteLn('■ CD als Laufwerk ',DrvChar,': gefunden!');π Write ('■ Aktuelle CD: ');ππ Write('(UPN-CODE:');π For i := 1 to 7 do Write(Char( (Upn[i] shr 4) or $30),π Char((Upn[i] and $f) or $30));π WriteLn(#8')');π WriteLn('■ Audio-Tracks : ',loautr,'..',hiautr);π WriteLn(' Laufzeiten : ');π For i := CD.LoAuTr to CD.HiAuTr doπ With VtoC.Titles[i] doπ WriteLn(i,Title:10, RunMin:6,':',RunSec);π no := 1;π len := -1;ππ if CD_Stop thenπ if not CD_Play( no ,len)π then WriteLn('! Fehler-Status: ',STATUS and $F);ππ ch := ' ';π While ch <> #27 doπ beginπ While ch = ' ' doπ With CD doπ beginπ if CD_Position thenπ Write('Playing Track ',CTrk,' : ',CMin:2,':',CSek:2,' '#13);π Delay(1500);π if KeyPressedπ then ch := ReadKey;π end;π Case ch ofπ '+' : Inc(no);π '-' : Dec(no);π end;π if ch <> #27 then ch := ' ';π if no > cd.HiAUTr then Dec(no);π if no < cd.LoAuTr then Inc(no);π if CD_Stopπ then CD_Play(no, len);π end;π cd_stop;π clreol;π WriteLn(' CD stopped...');π endπ else WriteLn('Leider kein CD-ROM gefunden...');πend.ππ 2 05-28-9313:38ALL GREG ESTABROOKS Change Default Drive IMPORT 30 ╣αÉ { Author: Greg Estabrooks }πProgram DriveInf;πUsesπ Crt, (* ClrScr routine *)π Dos; (* Register Type, Intr() Routine *)πVarπ Regs :Registers; (* To hold register info For Intr() *)π CH :Char; (* To hold Drive to change to *)πππFunction GetDrive :Byte;π (* Routine to Determine the default drive *)πbeginπ Regs.AX := $1900; (* Function to determine drive *)π Intr($21,Regs); (* Call Dos int 21h *)π GetDrive := Regs.AL; (* Return Proper result *)π (* Returns 0 = A, 1 = B, 2 = C, ETC *)πend;ππProcedure ChangeDrive( Drive :Byte );π (* Routine to change default drive *)πbeginπ Regs.AH := $0E; (* Function to change Drives *)π Regs.DL := Drive; (* Drive to change to *)π Intr($21,Regs); (* Call Dos Int 21h *)πend;ππFunction NumDrives :Byte;π (* Routine to determine number of valid drives *)πVarπ CurDrive :Byte; (* Temporary storage For current drive*)πbeginπ CurDrive := GetDrive; (* Find out the current drive *)π Regs.AH := $0E; (* Function to change drives *)π Regs.DL := CurDrive; (* Change to current drive *)π Intr($21, Regs); (* Call Dos *)π NumDrives := Regs.AL; (* Return proper info to user *)πend;ππbeginπ ClrScr; (* Clear the screen *)π (* Write Current Drive to Screen *)π Writeln('Current Drive Is : ',CHR(GetDrive+65 ),':\');π Write('What Drive do you wish to change to ?[A..');π WriteLn(CHR(NumDrives + 64 ),']');π CH := ReadKey; (* Get Choice *)π CH := UpCase( CH ); (* Convert to uppercase *)π ChangeDrive( Ord( CH )-65 ); (* Change to chosen drive *)πend.π(**********************************************************************)πππ{ And here are the above in Inline Asm. I hope these help. }ππFunction GetDrive :Byte; Assembler;π { Routine to Determine the default drive }πAsmπ Mov AX,$1900 { Function to determine drive }π Int $21 { Call Dos int 21h }π { Returns 0 = A, 1 = B, 2 = C, ETC }πend;{GetDrive}ππProcedure ChangeDrive( Drive :Byte ); Assembler;π { Routine to change default drive }π { 0 = A, 1 = B, 2 = C, ETC }πAsmπ Mov AH,$0E { Function to change Drives }π Mov DL,Drive { Drive to change to }π Int $21 { Call Dos Int 21h }πend;{ChangeDrive}ππFunction NumDrives :Byte; Assembler;π { Routine to determine number of valid drives }πAsmπ Call GetDrive { Find out the current drive, Returns }π { Drive in AL }π Mov AH,$0E { Function to change drives }π Mov DL,AL { Change to current drive }π Int $21 { Call Dos }π { Number of drives is returns in AL }πend;{NumDrives}ππ 3 05-28-9313:38ALL LEE BARKER Finding the Default DriveIMPORT 9 ╣┬y *--* 03-31-93 - 21:49:00 *--*π/. Date: 03-31-93 (09:51) Number: 24032 of 24035π To: IOANNIS HADJIIOANNOU Refer#: 23844πFrom: LEE BARKER Read: NOπSubj: Current Drive Status: PUBLIC MESSAGEπConf: R-TP (552) Read Type: GENERAL (A) (+)ππ┌─┬─────────────── Ioannis Hadjiioannou ───────────────┬─╖π│o│ How can I find which drive is the default drive? │o║π╘═╧══════════════════════════════════════════════════════════╧═╝πWhile X may mark the spot, period marks/inhibits the drive.ππUses Dos;πbeginπ Writeln(fexpand('.'));πend.ππAs For getting the drive Label look up findfirst With anπattribute of "directory".π---π ■ Tags τ Us ■ Operator! Trace this call and tell me where I amπ * Suburban Software - Home of King of the Board(tm) - 708-636-6694π * PostLink(tm) v1.05 SUBSOFT (#715) : RelayNet(tm) Hubππ(61 min left), (H)elp, end of Message Command? 4 05-28-9313:38ALL SWAG SUPPORT TEAM Detect Non-DOS drives IMPORT 5 ╣à┤ {│o│ How do I detect active drives in Pascal? My Program would │o║π│o│ crash if you Typed in a non-existent drive as either │o║π│o│ source or destination. │o║π}πUses Dos;πVar sr : SearchRec;πbeginπ findfirst('k:\*.*',AnyFile,sr);π if Doserror=0π then Writeln('It is there all right!')π else Writeln('Sorry, could not find it.');πend.ππ 5 05-28-9313:38ALL GREG VIGNEAULT Get Drive ID IMPORT 25 ╣ûè {π Below is TP code to do drive-Type identification. I leave it as aπ research exercise For you to create code to differentiate betweenπ a RAM drive and fixed disk, if that's needed.ππ}π(********************************************************************)π Program DrvCount; { coded by Greg Vigneault }π Uses Crt,Dos; { For MsDos Function }π Var Drives :Byte; { count of logical drives }π Reg :Registers; { to access CPU Registers }π ThisDrive :Byte; { loop count }π DriveType :String[16]; { Type of drive found }π DataBuffer :Array [0..127] of Byte; { buffer For Dos i/o }π beginπ ClrScr; { remove screen clutter }π Reg.AH := $19; { get current disk code }π MsDos(Reg); { via Dos }π Reg.DL := Reg.AL; { returned drive code }π Reg.AH := $E; { select disk }π MsDos(Reg); { via Dos }π Drives := Reg.AL; { number of logical drives }ππ WriteLn('Number of logical drives: ', Drives );ππ Intr($11,Reg); { get system equipment flag }π if ( (Reg.AX and 1) <> 0 ) { any floppies installed? }π then WriteLn('(physical floppy drives: ',π (Reg.AX SHR 6) and 3, ')' ); { get bits 6&7 }ππ For ThisDrive := 1 to Drives do begin { scan all drives }π Reg.AX := $440D; { using generic I/O control }π Reg.CX := $860; { to get drive parameters }π Reg.BL := ThisDrive; { For this drive }π Reg.DX := ofs(DataBuffer); { Pointer to scratch buffer }π Reg.DS := Seg(DataBuffer); { in is DS:DX }π MsDos(Reg); { thank you, Dos }π Case ( DataBuffer[1] ) of { which Type it is... }π 0 : DriveType := '360 KB 5.25" FDD';π 1 : DriveType := '1.2 MB 5.25" FDD';π 2 : DriveType := '720 KB 3.5" FDD';π 3 : DriveType := 'SD 8"'; { a relic from CP/M roots }π 4 : DriveType := 'DD 8"'; { ditto }π 5 : DriveType := 'Fixed/RAM disk'; { HDD or RAM }π 6 : DriveType := 'Tape drive'; { a good investment }π 7 : DriveType := '1.44 MB 3.5" FDD' { or "other" drv }π else DriveType := '???'; { anything else }π end; { Case }π WriteLn(' - ', CHR(ThisDrive+64),': (', DriveType, ')' );π { further code could ID between RAM drive & HDD }π end; { For }π end. { Program }π(********************************************************************)π 6 05-28-9313:38ALL SWAG SUPPORT TEAM Changing & Detecting DrvsIMPORT 5 ╣7╖ {πHere are some routines For Changing and detecting drives.π}ππUses Crt, Dos;πVarπ Regs :Registers;ππFunction GetDrive :Byte;πbeginπ Regs.AX := $1900;π Intr($21,Regs);π GetDrive := (Regs.AL + 1);π (* Returns 1 = A:, 2 = B:, 3 = C:, Etc *)πend;ππProcedure ChangeDrive(Drive :Byte);πbeginπ Regs.AH := $0E;π Regs.DL := Drive; (* Drive 1 = A:, 2 = B:, 3 = C: *)π Intr($21,Regs);πend;ππbeginπ ClrScr;π Writeln(' Current Drive : ',CHR( GetDrive+64 ));πend.π 7 05-28-9313:38ALL SWAG SUPPORT TEAM Drive ID IMPORT 4 ╣Ω) Program DriveID;πUsesπ Dos;πConstπ First : Boolean = True;πVarπ Count : Integer;πbeginπ Write('You have the following Drives: ');π For Count := 3 to 26 doπ if DiskSize(Count) > 0 thenπ beginπ if not First thenπ Write(', ');π First := False;π Write(UpCase(Chr(ord('a') - 1 + Count)),':')π end;π WriteLn;πend.π 8 05-28-9313:38ALL SWAG SUPPORT TEAM Detect Active DOS Drives IMPORT 10 ╣═╜ { JW│ How do I detect active drives in Pascal? My Program would crash if youπ │ Typed in a non-existent drive as either source or destination.ππHere's the method I use:π}πUsesπ Dos;ππVarπ Isthere : Boolean;ππFunction ChangeDrive( drv: Char ): Boolean;π(*πTakes drive letter as parameter, returns True if changeπsucceeded, False if change failed (invalid drive)π*)πVarπ Regs: Dos.Registers;π NewDrv: Byte;πbeginπ(* Calculate drive code For desired drive *)π NewDrv := orD( UpCase( drv ) ) - orD( 'A' ); (* A: = 0 *)ππ(* Change drive *)π Regs.DL := NewDrv;π Regs.AH := $0E; (* Function 0Eh: Select Disk *)π MSDos( Regs );ππ(* See if the change 'took' *)π Regs.AH := $19; (* Function 19h: Get current drive *)π MSDos( Regs );π ChangeDrive := (Regs.AL = NewDrv);πend; (* ChangeDrive *)ππbeginπ isthere := ChangeDrive('a');π Writeln ('a: ',isthere);π isthere := ChangeDrive('b');π Writeln ('b: ',isthere);π isthere := ChangeDrive('c');π Writeln ('c: ',isthere);π isthere := ChangeDrive('d');π Writeln ('d: ',isthere);π isthere := ChangeDrive('e');π Writeln ('e: ',isthere);πend.π 9 05-28-9313:38ALL JACOB STEDMAN Is Drive Valid IMPORT 35 ╣└Z {π> Does anyone know if there is a way For a Pascal Program to determineπ> whether a drive is a local hard drive, a network drive, a Dosπ> SUBSTituted drive, or a RAMDRIVE?ππHmm... I'm reading this one week after it got posted. and a month after theπoriginal question. I haven't read last week's messages, hope you hadn'tπrecieved to many answers about this now. But because you apparently hadn't gotπanything two weeks after asking, I thought you may want this, so here comes...ππThere is a service in Dos that identifies a given drive as local or remote.πThis service also tells you if the drive is SUBSTed. You can also get infoπabout whether it Uses removable media from another service. There is no way toπdetect a RAM-drive, as Far as I know, and I've got the facts from Microsoft'sπown MSJ! The Dos 5 DosSHELL simple checks the volume identifier. if it'sπ'MS-RAMDRIVE', 'RDV' or 'VDISK', the drive is ASSUMED to be a RAM-disk. Butπit's, again according to Microsoft Systems Journal, impossible to foolproofπcheck if a drive is a logical RAM-drive. A design flaw in Dos.ππHowever, I will show a few lines of TP-code For checking if a drive is remoteπor local, and SUBSTed or not. I use the TP 5.5 (and older) method of Intr-callsπFor simulating Asm, of course if could be written clearer With TP6'sπAsm-keyWord. The code consists of the actual Function and a test stub, cut theπstub when you have looked at it. Code Compiles and runs fine on my system; Iπcouldn't test if it work With remote drives, but it should. I've used similarπcode that worked With that too, so...ππ}πProgram TestDrv;ππ{ --- A very short test-Program For Dos-IOCTL, Jacob Stedman 930223 --- }ππUsesπ Dos;ππFunction IsDriveValid(cDrive: Char; Var bLocal, bSUBST: Boolean): Boolean;π{π Parameters: cDrive is the drive letter, 'A' to 'Z', that's aboutπ to be checked. if not in this range, the Function will return False.ππ Returns: Function returns True if the given drive is valid, elseπ False (!). bLocal is set if drive is local, bSUBST if drive isπ substituted. if Function returns False, the Booleans are undefined.π}πVarπ rCPU: Dos.Registers;πbeginπ { --- Call Dos and process returns --- }π if not (UpCase(cDrive) in ['A'..'Z']) then { --- letter OK?--- }π IsDriveValid := Falseπ elseπ beginπ { --- Valid letter, set up For the Dos-call --- }π rCPU.bx := ord(UpCase(cDrive))-ord('A')+1;π rCPU.ax := $4409;π { --- Call the Dos IOCTL (InOutConTroL)-Functions --- }π Intr($21, rCPU);π if (rCPU.ax and FCarry) = FCarry thenπ IsDriveValid := Falseπ elseπ begin { --- drive is valid, check status --- }π IsDriveValid := True;π bLocal := ((rCPU.dx and $1000) = $0000);π if bLocal thenπ bSUBST := ((rCPU.dx and $8000) = $8000)π elseπ bSUBST := False;π end;π end;πend;ππVarπ cCurChar : Char; { loop counter, drive }π bLocal,π bSUBST : Boolean; { drive local/remote?; SUBSTed or not? }ππbeginπ { --- Write header --- }π Writeln; Writeln(' VALID DRIVES:'); Writeln;π { --- Loop from 'A' to 'Z', For each iteration check a drive --- }π For cCurChar := 'A' to 'Z' doπ if IsDriveValid(cCurChar, bLocal, bSUBST) thenπ beginπ Write(cCurChar, ': ');π if bLocal thenπ Write(' local ')π elseπ Write(' remote');π if bSUBST thenπ Write(' SUBSTed ')π elseπ Write(' not SUBSTed');π Writeln;π end;π { --- Write footer --- }π Writeln;πend.ππ{πThe code is simple. It calls the Dos IOCTL-service #09h, 'Is Drive Remote',πwith the drive number (1-A:, 2-B:, ...) in the bl-register. if the drive isn'tπvalid, the carry flag is set. if valid, carry is clear, and the dx-registerπcontains bit-fields you're interested in. Bit 12 is 1 if remote, 0 if local. ifπlocal, bit 15 is 1 if the drive is a substitution. In TP, you get access toπthem, in this Case, by using the 'and'-binary operator.ππI guess you're interested in making a Filemanager or a report util or thatπlike. then, you're maybe interested to get source For detection of CD-ROMπdrives and floppys? if so, post me a new msg. I always like to recieve newπmail... I didn't include this here, this msg is too long without that extraπcode. Feel free to Write if you get any problems.π} 10 05-28-9313:38ALL MARCO MILTENBURG Get Drive Parameters IMPORT 16 ╣[H {πAuthor : MARCO MILTENBURGππHere's an overview of INT13h, Function 8 :ππName : Get drive parametersππInput : AH = 08hπ DL = <drive> 00h - 7Fh : Floppy diskπ 80h - FFh : HarddiskππOutput: if succesfullπ -------------π Carry is clearedπ BL = <driveType> 01 : 360 KBytes, 40 tracks, 5.25 Inchπ 02 : 1,2 MBytes, 80 tracks, 5.25 Inchπ 03 : 720 KBytes, 80 tracks, 3.5 Inchπ 04 : 1,44 MBytes, 80 tracks, 3,5 Inchπ CH = Lower 8 bits of maximum cylindernumberπ CL = bits 6-7 : Highest 2 bits of maximum cylindernumberπ bits 0-5 : Maximum sectornumberπ DH = Maximum headnumberπ DL = Number of connected drivesπ ES:DI = Pointer to disk drive parameter tableππ if failedπ ---------π Carry is setπ AH = errorstatusππAs you can see, you must do more to get the cylindernumber. Here's a littleπpascal code :π}ππUsesπ Dos;ππConstπ DriveTypes : Array[0..4] of String[18] = ('Harddisk ',π '360 kB - 5.25 Inch',π '1.2 MB - 5.25 Inch',π '720 kB - 3.5 Inch ',π '1.44 MB - 3.5 Inch');πVarπ Regs : Registers;πbeginπ Regs.AH := $08;π Regs.DL := $80;π Intr($13, Regs);ππ WriteLn ('DriveType : ', DriveTypes[Regs.BL]);π WriteLn ('Cylinders : ', 256 * (Regs.CL SHR 6) + Regs.CH + 1);π WriteLn ('Sectors : ', Regs.CL and $3F);π WriteLn ('Heads : ', Regs.DH + 1);ππend.π{πThis will give you the right information from your diskdrives. I noticed thatπmy harddisks will always be reported as driveType 0 (zero). I don't know forπsure if that is documented, but it seems to be logical ;-).π} 11 05-28-9313:38ALL GAYLE DAVIS Another IS DRIVE READY IMPORT 23 ╣áÇ {πAuthor : GAYLE DAVISππ> It will check For example, drive A:, and if there is no disk in theπ>drive it will return False, if it is ready it will return True..ππThere is a problem that you will have to deal With here from the beginning.πFirst of all Dos can't easily tell if the problem is that you drive door isπopen, say in drive 'A', or if the disk is unformatted or unreadable. Hereπis some code that I use to solve the problem using INT25. do not TRY THISπON A HARD DRIVE.π}πUsesπ Dos;ππFunction DisketteDrives : Integer;πVarπ Regs : Registers;πbeginπ FILLChar (Regs, SIZEOF (Regs), #0);π INTR ($11, Regs);π if Regs.AX and $0001 = 0 thenπ DisketteDrives := 0π elseπ DisketteDrives := ( (Regs.AX SHL 8) SHR 14) + 1;πend;ππFunction IsDriveReady (DriveSpec : Char) : Boolean; {A,B,etc}πVarπ result : Word;π Drive,π number,π logical : Word;π buf : Array [1..512] of Byte;π Regs : Registers;πbeginπ IsDriveReady := True; { Assume True to start }π Drive := ORD (UPCASE (DriveSpec) ) - 65; { 0=a, 1=b, etc }ππ if Drive > DisketteDrives thenπ Exit; { do not CHECK HARD DRIVES }ππ number := 1;π logical := 1;ππ Inline (π $55 / { PUSH BP ; Interrupt 25 trashes all}π $1E / { PUSH DS ; Store DS }π $33 / $C0 / { xor AX,AX ; set AX to zero }π $89 / $86 / result / { MOV Result, AX ; Move AX to Result }π $8A / $86 / Drive / { MOV AL, Drive ; Move Drive to AL }π $8B / $8E / number / { MOV CX, Number ; Move Number to CX }π $8B / $96 / logical / { MOV DX, Logical; Move Logical to DX }π $C5 / $9e / buf / { LDS BX, Buf ; Move Buf to DS:BX }π $CD / $25 / { INT 25h ; Call interrupt $25 }π $5B / { POP BX ; Remove the flags valu fr}π $1F / { POP DS ; Restore DS }π $5D / { POP BP ; Restore BP }π $73 / $04 / { JNB Done ; Jump ... }π $89 / $86 / result); { MOV Result, AX ; move error code to AX }π { Done: }ππ IsDriveReady := (result = 0);πend;ππ(*πAlso, you could change the ISDRIVEREADY Function if you wanted to find outπWHY the drive isn't ready by checking the LO(result). Like this :ππ if result <> 0 thenπ beginπ Case LO (result) OFπ 0 : FloppyState := WritePROTECT; { should not ever happen }π 1..4 : FloppyState := DOOROPEN;π 5..12 : FloppyState := NOFORMAT;π elseπ FloppyState := DOOROPEN;π endπ endπ elseπ FloppyState := DRIVEREADY;π*)π 12 05-28-9313:38ALL BO BENDTSEN Show SUBST drives IMPORT 9 ╣ {πBO BendTSENππ> There's already a methode For finding all available drives withoutπ> accessing them - I'd like to have one to get the volume Labels of theπ> harddisks, SUBST- and network-drives without waiting seconds While theπ> Program accesses all the 20 drives available in my system ... ;-)ππTry this, it will show any SUBST drives, if a \\ first in the name is returnedπyou will have a network server name following.π}πUsesπ Dos;ππFunction ResolvePath(Var s : String) : Boolean;πVarπ r : Registers;π x : Byte;πbeginπ ResolvePath := False;π s := s + #0;π r.ds := Seg(S);π r.si := Ofs(S) + 1;π r.es := Seg(S);π r.di := Ofs(S) + 1;π r.ah := $60;π Intr($21, R);π If r.flags and 1 = 1 Thenπ Exit; { if ZF set then error }π ResolvePath := True;π x := 0;π While (s[x + 1] <> #0) And (x < 128) Doπ Inc(x);π s[0] := Chr(x);πend;ππVarπ DriveName : String;ππbeginπ DriveName := 'C';π Writeln(ResolvePath(DriveName));π Writeln(DriveName);πend.π 13 05-28-9313:38ALL SWAG SUPPORT TEAM Does HD Exist IMPORT 7 ╣╫ Program CheckForHDExistence;πUsesπ Dos;ππFunction checkdsk(drive:Char):Boolean;πbeginπ checkdsk:=disksize(Byte(upcase(drive))-64)>0;πend;ππbeginπ { Doesn't work For Floppies unless a disk is present }π if checkdsk('A') then Writeln('Valid! A')π else Writeln('Not Valid A');π if checkdsk('B') then Writeln('Valid! B')π else Writeln('Not Valid B');π if checkdsk('C') then Writeln('Valid! C')π else Writeln('Not Valid C');π if checkdsk('D') then Writeln('Valid! D')π else Writeln('Not Valid D');π if checkdsk('E') then Writeln('Valid! E')π else Writeln('Not Valid E');π if checkdsk('F') then Writeln('Valid! F')π else Writeln('Not Valid F');πend.ππ 14 05-28-9313:38ALL CHRIS PRIEDE Find LASTDRIVE in ASM IMPORT 7 ╣(─ Function LastDrive: Char; Assembler;πAsmπ mov ah, 19hπ int 21hπ push ax { save default drive }π mov ah, 0Ehπ mov dl, 19hπ int 21hπ mov cl, alπ dec cxπ@@CheckDrive:π mov ah, 0Eh { check if drive valid }π mov dl, clπ int 21hπ mov ah, 19hπ int 21hπ cmp cl, alπ je @@Validπ dec cl { check next lovest drive number }π jmp @@CheckDriveπ@@Valid:π pop axπ mov dl, alπ mov ah, 0Ehπ int 21h { restore default drive }π mov al, clπ add al, 'A'πend;πππ(*πLastDrive will return letter of the last valid drive. To checkπif the drive letter entered is valid:ππif Upcase(DriveLetter) <= LastDriveπ then {valid drive}π else {bad drive};π*) 15 05-28-9313:38ALL SWAG SUPPORT TEAM Drive Serial Number IMPORT 14 ╣╪ {π>How can [a disk serial number] be read from TP? Can it be changed other thanπ>by re-Formatting? I can't find any reference to serial numberπ>in the Dos 5.0 users guide except a passing one in the sectionπ>on the ForMAT command.π}πUses Dos;πVar regs : Registers;π LabelInfo : Recordπ InfoLevel : Word; {Always 0}π SerialNum : LongInt;π VolumeLabel : Array [1..11] of Char;π FileSystemType : Array [1..8] of Char;π end;πbeginππ if lo(DosVersion)<4 thenπ beginπ Writeln ('Only works With Dos 4.0 or higher');π Exit;π end;ππ LabelInfo.InfoLevel := 0; {Set Info level (0 is the only legal value)}π With regs doπ beginπ ax := $6900; {Function $69 With 0 in AL gets, With 1 in AL sets}π bl := 0; {Drive, 0 For default, 1 For A:, 2 For B:, ...}π ds := seg(LabelInfo); {DS:DX points at structure}π dx := ofs(LabelInfo);π es := 0; {Do not have garbage in segment Registers}π flags := 0; { or in flags}ππ MsDos(Regs);ππ if Odd(flags) then {Carry set if error}π beginπ Case AX ofπ 1: Writeln ('Illegal attempt to get Label from network drv');π 5: Writeln ('No Extended BPB on disk (Format old)');π else Writeln ('Unknown error');π end;π end;π end;ππ{On return, fills SerialNum, VolumeLabel, and FileSystemType fields.π places 'FAT12 ' or 'FAT16 ' in FileSystemType, For 12- or 16-bit FATπentries. With AL=1, will use info you store in LabelInfo to set disk'sπextended BPB}π 16 05-28-9313:38ALL SWAG SUPPORT TEAM Drives TRUE name IMPORT 6 ╣ûß Program TrueName; uses DOS;ππ function RealName(FakeName:String):String;π Var Temp:String;π beginπ FakeName := FakeName + #0; { ASCIIZ }π With Regs doπ beginπ AH := $60;π DS := Seg(FakeName); SI := Ofs(FakeName[1]);π ES := Seg(Temp); DI := OfS(Temp[1]);π INTR($21,Regs);π DOSERROR := AX * ((Flags And FCarry) shr 7);π Temp[0] := #255;π Temp[0] := CHAR(POS(#0,Temp)-1);π end;π If DosError <> 0 then Temp := '';π RealName := Temp;π end;ππbegin writeln( RealName( Paramstr(1) ) end.π 17 05-28-9313:38ALL SWAG SUPPORT TEAM Drive Volume ID IMPORT 20 ╣m {π In the thread concerning copy protection (in which I have noπ interest) the serial number of a disk was mentioned.π How can this be read from TP? Can it be changed other thanπ by re-Formatting? I can't find any reference to serial numberπ in the Dos 5.0 users guide except a passing one in the sectionπ on the ForMAT command.ππReading the volume id number is no problem:ππreads volume id number -- not sophisticated enough toπdetermine whether disk was Formatted With a Dos versionπnew enough to assign volume id }ππUses Dos;ππFunction Byte2HexSt(b : Byte) : String;πConstπ hexChars: Array [0..$F] of Char =π '0123456789ABCDEF';πbeginπ Byte2HexSt := hexChars[b shr 4] + hexChars[b and $F];πend;ππProcedure ResetDisk(DriveNo : Byte);πVarπ reg : Registers;πbeginπ reg.ah := 0; { bios Function reset drive system }π reg.dl := DriveNo;π intr($13,reg);πend;ππFunction VolIDSt(DriveCh : Char) : String;π{ returns Volume ID number as a String of hex digits }πVarπ reg : Registers;π try : Integer;π buff : Array[0..1023] of Byte;πbeginπ DriveCh := upCase(DriveCh);π try := 0;π Repeatπ reg.ax := $0201; { ah = bios Function read disk sector }π { al = read 1 sector }π reg.cx := $0001; { ch = cylinder number }π { cl = sector number }π reg.dh := 0; { head number }π reg.dl := ord(DriveCh) - 65; { drive number }π reg.es := seg(buff);π reg.bx := ofs(buff);π intr($13,reg);π inc(try);π if reg.flags and FCarry <> 0 then ResetDisk(reg.dl);π Until ((reg.flags and FCarry) = 0) or (try = 3);π if reg.flags and FCarry <> 0π then VolIDSt := 'Error attempting to read volume ID number'π else VolIDSt := Byte2HexSt(buff[$2A]) +π Byte2HexSt(buff[$29]) + '-' +π Byte2HexSt(buff[$28]) +π Byte2HexSt(buff[$27]);πend;ππ{πCan the volume id number be changed? You bet.ππAlthough it is True that DISKCOPY will not copy the volume idπnumber from the original disk, it's still a pretty weak basis For aπcopy protection scheme. I consider myself a pretty unsophisticatedπProgrammer, but it only took me a few minutes of fooling around toπfigure out where the volume id number is on the disk. then all youπhave to do is grab an interrupt reference and quickly Type up someπcode to read and Write to the right spot on the disk.π}π 18 05-28-9313:38ALL SWAG SUPPORT TEAM Drive VOL-Serial IMPORT 18 ╣|ö {π This Turbo Pascal code will read the serial number and volumeπ from disks that have been Formatted under Dos 4.0 and higher ...π}π(*-------------------------------------------------------------------*)πProgram VolSN; { reads disk serial number & volume Label (Dos 4.0+) }πUses Dos;πType MediaID = Recordπ InfoLevel : Word;π SerialN : LongInt;π VLabel : Array [0..10] of Char;π SysName : Array [0..7] of Char;π end;ππVar IDbuffer : MediaID;π SerialNumber : LongInt;π VolumeLabel : String[12];π Reg : Registers;π loopc : Byte;πbeginπ WriteLn( #10, 'VolStat 0.00 Greg Vigneault', #10 );ππ Reg.AH := $30; { Function to get Dos version number }π MsDos( Reg ); { via MS-Dos }π if ( Reg.AL < 4 ) or ( Reg.AL = 10 )π then begin { must be Dos 4.0 or above (& not OS/2?) }π WriteLn( 'Dos version error',#7 );π Halt(1) { abort Program }π end;ππ Reg.AX := $6900; { Dos Function }π Reg.BL := 0; { Drive (0=current,1=A,2=B,etc)}π Reg.DS := Seg( IDbuffer ); { place to return data }π Reg.DX := ofs( IDbuffer );π MsDos( Reg ); { call Dos }π { there'll be an error if disk doesn't have a serial # ... }π if ( Reg.FLAGS and 1 ) <> 0 { carry flag set? }π then beginπ WriteLn( 'Dos error getting Media ID',#7 );π Halt(2);π end;ππ SerialNumber := IDbuffer.SerialN; { get serial number }ππ WriteLn( 'Disk serial number: ', SerialNumber );ππ VolumeLabel := '';π loopc := 0;π While ( IDbuffer.VLabel[ loopc ] <> ' ' )π do beginπ VolumeLabel[ loopc+1 ] := IDbuffer.VLabel[ loopc ];π inC( loopc );π end;π VolumeLabel[0] := CHR( loopc ); { set TP String length }π if ( loopc <> 0 ) thenπ WriteLn( 'Disk volume Label : ', VolumeLabel );πend.π 19 05-28-9313:38ALL SWAG SUPPORT TEAM Another VOL_Serial IMPORT 17 ╣ ╝ {π>Who can give me the source code in TP 6.0 which reads a HardDisks Volumeπ>Serial Number ?ππStarting With Dos 4 this inFormation can be GET/SET using inT 21h func 69hπ Entry AH =69hπ Al = 00h Get Serial number and Labelπ Al = 01h Set Serial numberπ BL = drive number 0=default, 1=A: .....)π DS:DX Pointer to a 24 Bytes Buffer (see below)π Returnπ Cf set on errorπ AX = error code (same as Int 21h AH = 59 )π CF Clear if Okπ if AL was 0 then Buffer is filled withπ offset size Contents:π 0 Word 0π 2 DWord the disk Serial numberπ 6 11 Bytes= volume Label or "NO NAME"π 16 8 Bytes = 'FAT12' or 'FAT16'ππ The buffer is actually a copy of ByteS $27 to $3D of the Sector 0 of the diskπ So With previous versions of Dos one should be able to do an Absolute readπ of sector 0 from the disk and extract the Info from a buffer. I did not dareπ doing it....ππ Last Thought: With Dos earlier than 4 , there was no disk serial numberπ so what the point looking For one .... !!!!π Although this info can be used to set one ???π (not by me... I need too badly my hard disk toπ experiment With Int 13h ..... )ππ Here is a Program that Get these Infos...π I did not dare trying the Set Function (AL=1...) see above...π}πProgram GetSerial;πUsesπ Dos;πVarπ Buffer : Array[0..23] of Byte;π R : Registers;π Serial : LongInt;π VLabel : String[11];π Fat : String[8];πbeginπ R.AH := $69;π R.AL := 0;π R.BL := 3; { C: Drive }π R.DS := Seg(Buffer);π R.DX := ofs(Buffer);π Intr($21,R);π if (R.Flags and Fcarry = 0) thenπ beginπ Move(Buffer[2], Serial, Sizeof(LongInt));π Move(Buffer[6], VLabel[1], 11);π VLabel[0] := Char(11);π Move(Buffer[16], Fat[1], 8);π Fat[0] := Char(8);π end;π Writeln(VLabel);π Writeln(Fat);π readln;πend.π 20 05-28-9313:38ALL SVERRE HJELM Volume Labels IMPORT 30 ╣Ç > I need a way to find the volume Label of a drive. Any suggestions orπ> source code?ππ{$S-,R-,V-,I-,N-,B-,F-}ππUnit Volume;ππInterfaceππUsesπ Dos;ππTypeππ Drive = Byte;π VolumeName = String [11];ππ VolFCB = Recordπ FCB_Flag : Byte;π Reserved : Array [1..5] of Byte;π FileAttr : Byte;π Drive_ID : Byte;π FileName : Array [1..8] of Byte;π File_Ext : Array [1..3] of Byte;π Unused_A : Array [1..5] of Byte;π File_New : Array [1..8] of Byte;π fExt_New : Array [1..3] of Byte;π Unused_B : Array [1..9] of Byteπ end;ππFunction DelVol (D : Byte) : Boolean;πFunction AddVol (D : Byte; V : VolumeName) : Boolean;πFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πFunction GetVol (D : Byte) : VolumeName;ππImplementationππProcedure Pad_Name (Var V : VolumeName);πbeginπ While LENGTH (V) <> 11 DOπ V := V + ' 'πend;ππFunction Fix_Ext_Sym (Var V : VolumeName) : Byte;πVarπ I : Byte;πbeginπ I := POS ('.', V);π if I > 0 thenπ DELETE (V, I, 1);π Fix_Ext_Sym := Iπend;ππFunction Extract_Name (S : SearchRec) : VolumeName;πVarπ H, I : Byte;πbeginπ I := Fix_Ext_Sym (S.Name);π if (I > 0) and (I < 9) thenπ For H := 1 to (9 - I) DOπ INSERT (' ', S.Name, I);π Extract_Name := S.Nameπend;ππProcedure Fix_Name (Var V : VolumeName);πVarπ I : Byte;πbeginπ Pad_Name (V);π For I := 1 to 11π do V [I] := UPCASE (V [I])πend;ππFunction Valid_Drive_Num (D : Byte) : Boolean;πbeginπ Valid_Drive_Num := (D >= 1) and (D <= 26)πend;ππFunction Find_Vol (D : Byte; Var S : SearchRec) : Boolean;πbeginπ FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);π Find_Vol := DosError = 0πend;ππProcedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.File_New [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.fExt_New [I] := ORD (V [I + 8])πend;ππProcedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);πVarπ I : Byte;πbeginπ For I := 1 to 8 DOπ FCB.FileName [I] := ORD (V [I]);π For I := 1 to 3 DOπ FCB.File_Ext [I] := ORD (V [I + 8])πend;ππFunction Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;πVarπ Regs : Registers;πbeginπ FCB.Drive_ID := D;π FCB.FCB_Flag := $FF;π FCB.FileAttr := $08;π Regs.DS := SEG (FCB);π Regs.DX := OFS (FCB);π Regs.AX := Fnxn;π MSDos (Regs);π Vol_Int21 := Regs.AL = 0πend;ππFunction DelVol (D : Byte) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π V : VolumeName;πbeginπ DelVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π DelVol := Vol_Int21 ($1300, D, FCB)π endπ endπend;ππFunction AddVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;πbeginπ AddVol := False;π if Valid_Drive_Num (D) thenπ beginπ if not Find_Vol (D, sRec) thenπ beginπ Fix_Name (V);π Fix_FCB_FileName (V, FCB);π AddVol := Vol_Int21 ($1600, D, FCB)π endπ endπend;ππFunction ChgVol (D : Byte; V : VolumeName) : Boolean;πVarπ sRec : SearchRec;π FCB : VolFCB;π x : Byte;πbeginπ ChgVol := False;π if Valid_Drive_Num (D) thenπ beginπ if Find_Vol (D, sRec) thenπ beginπ x := Fix_Ext_Sym (V);π Fix_Name (V);π Fix_FCB_NewFile (V, FCB);π V := Extract_Name (sRec);π Pad_Name (V);π Fix_FCB_FileName (V, FCB);π ChgVol := Vol_Int21 ($1700, D, FCB)π endπ endπend;ππFunction GetVol (D : Byte) : VolumeName;πVarπ sRec : SearchRec;πbeginπ GetVol := '';π if Valid_Drive_Num (D) thenπ if Find_Vol (D, sRec) thenπ GetVol := Extract_Name (sRec)πend;ππend.π 21 05-28-9313:38ALL SWAG SUPPORT TEAM Another Volume Label IMPORT 35 ╣πL {πCould somebody help me out here? I'm trying to Write aπProgram that reads the File names and their attributes fromπdisk/drive.ππUnit volLabel;ππ Type String11 = String[11];π Function GetCurrentVolumeLabel : String11;π Procedure DelVolumeLabel(CurrentVolumeLabel:String11);π Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);π ( to change a volume Label: delete old, then Write new )π}ππ(* Implementation *)ππUsesπ Dos;ππVarπ oldir : String; { only For test Program }ππTypeπ ExtendedFCBType = Recordπ ExtendedFCBflag : Byte;π Reserved1 : Array[1..5] of Byte;π Attr : Byte;π DriveID : Byte;π FileName : Array[1..8] of Char;π FileExt : Array[1..3] of Char;π CurrentBlockNum : Word;π RecordSize : Word;π FileSize : LongInt;π PackedDate : Word;π PackedTime : Word;π Reserved2 : Array[1..8] of Byte;π CurrentRecNum : Byte;π RandomRecNum : LongInt;π end;ππType String11 = String[11];πFunction GetCurrentVolumeLabel : String11;πVarπ CurrentDrive: String;π VolumeLabel : SearchRec; { defined in the Dos Unit }π i : Word;πbegin { 12345678901 }π GetCurrentVolumeLabel:= 'no Label ';π getdir(0,CurrentDrive); {in Dos Unit }π CurrentDrive:= copy(CurrentDrive,1,3) + '*.*';π {get Volume Label in A: drive}π findfirst(CurrentDrive,VolumeID,VolumeLabel);π if Doserror=0 thenπ With VolumeLabel doπ beginπ {remove period}π delete(VolumeLabel.name,pos('.',VolumeLabel.name),1);π { pad to 11 Chars }π For i:= length(name) to 11 do name:= name + ' ';π GetCurrentVolumeLabel:= name;π end; { With VolumeLabel}πend; {of GetCurrentVolumeLabel }ππProcedure DelVolumeLabel(CurrentVolumeLabel:String11);π{delete volume Label from disk in current drive}πVarπ regs : Registers;π FCB : ExtendedFCBType;πbeginπ fillChar(FCB,sizeof(FCB),#0); {initialize FCB With nulls }π With FCB doπ beginπ ExtendedFCBflag:= $ff; { always }π Attr := VolumeID; {defined in the Dos Unit}π DriveID := 0; {default drive}π move(CurrentVolumeLabel[1],FileName,8); {you have to put these in}π move(CurrentVolumeLabel[9],FileExt ,3); {For some silly reason }π end; { With FCB do }ππ { set up regs For Dos call }π fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}π regs.ah:= $13; {Dos 1.0 delete File Function}π regs.ds:= seg(FCB);π regs.dx:= ofs(FCB);π MsDos(regs); {call Dos to delete the volume Label }π if regs.al=0 then Writeln('Success -- volume Label deleted.')π else Writeln('Failure -- volume Label not deleted.');πend; { of DelVolumeLabel }ππProcedure WriteVolumeLabel(CurrentVolumeLabel:String11);π{create volume Label from disk in current drive}πVarπ regs : Registers;π FCB : ExtendedFCBType;πbeginπ fillChar(FCB,sizeof(FCB),#0); {initialize FCB With nulls }π With FCB doπ beginπ ExtendedFCBflag:= $ff; { always }π Attr := VolumeID; {defined in the Dos Unit}π DriveID := 0; {default drive}π move(CurrentVolumeLabel[1],FileName,8);π move(CurrentVolumeLabel[9],FileExt ,3);π end; { With FCB do }ππ { set up regs For Dos call }π fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}π regs.ah:= $16; {Dos 1.0 create File Function}π regs.ds:= seg(FCB);π regs.dx:= ofs(FCB);π MsDos(regs); {call Dos to delete the volume Label }π if regs.al=0 then Writeln('Success -- volume Label written.')π else Writeln('Failure -- volume Label not written.');πend; { of WriteVolumeLabel }ππbegin { test Program }π getdir(0,oldir); { save current directory }π chdir('a:'); { play With diskette in A: }π Writeln('Old volume Label: ',GetCurrentVolumeLabel);π DelVolumeLabel(GetCurrentVolumeLabel);π WriteVolumeLabel('10987654321');π Writeln('New volume Label: ',GetCurrentVolumeLabel);π chdir(oldir); { go back to original directory }πend. { test program }π 22 05-28-9313:38ALL SWAG SUPPORT TEAM Yet Another Volume Label IMPORT 17 ╣Oε {π>I am having difficulty changing a disk volume Label using Turbo Pascal.π>Does anyone know how to acComplish this?π}πUsesπ Dos;ππType fcbType = Recordπ drive : Byte;π name : Array[1..8] of Char;π ext : Array[1..3] of Char;π fpos : Word;π recsize : Word;π fsize : LongInt;π fdate : Word;π ftime : Word;π reserv : Array[1..8] of Byte;π currec : Byte;π relrec : LongInt;π end;π extfcb = Recordπ flag : Byte; { must be $ff! }π reserv : Array[1..5] of Byte;π attrib : Byte;π fcb : fcbType;π end;πππFunction GetVolLabel(drive:Char):String;πVar sr : SearchRec;πbeginπ findfirst(drive+':\*.*',VolumeID,sr);π if Doserror=0 then GetVolLabel:=sr.nameπ else GetVolLabel:='';πend;πππProcedure setfcbname(Var fcb:fcbType; name:String);πVar p : Byte;πbeginπ p:=pos('.',name);π if p=0 then beginπ p:=length(name)+1;π name:=name+'.';π end;π fillChar(fcb.name,11,' ');π move(name[1],fcb.name,p-1);π move(name[p+1],fcb.ext,length(name)-p);πend;πππProcedure SetVolLabel(drive:Char; vLabel:String);πVar fcb : extfcb;π vl : PathStr;π regs : Registers;π f : File;πbeginπ vl:=GetVolLabel(drive);π fcb.flag:=$ff;π fcb.attrib:=VolumeID;π if vl<>'' then beginπ setfcbname(fcb.fcb,vl);π fcb.fcb.drive:=ord(UpCase(drive))-64;π regs.ah:=$13; { Delete File }π regs.ds:=seg(fcb);π regs.dx:=ofs(fcb);π msDos(regs);π end;π if vLabel<>'' then beginπ fcb.fcb.drive:=ord(UpCase(drive))-64;π setfcbname(fcb.fcb,vLabel);π With regs do beginπ ah:=$16; { Create File }π ds:=seg(fcb);π dx:=ofs(fcb);π msDos(regs);π ah:=$10; { Close File }π ds:=seg(fcb);π dx:=ofs(fcb);π msDos(regs);π end;π end;πend;π 23 06-22-9309:16ALL SWAG SUPPORT TEAM Get Drive ID & Labels IMPORT 29 ╣J UNIT FCBLabel;π{Turbo Pascal unit for manipulating volume labels}ππINTERFACEπUSESπ DOS;πTYPEπ DriveType = String[1];π DiskIDType = String[11];ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType;π NewDiskID:DiskIDType): Boolean;πFUNCTION DeleteDiskID(Drive:DriveType): Boolean;ππIMPLEMENTATIONπTYPEπ ExtendedFCBRecord = RECORDπ ExtFCB : Byte;π Res1 : ARRAY[1..5] OF Byte;π Attr : Byte;π Drive : Byte;π Name1 : ARRAY[1..11] OF Char;π Unused1: ARRAY[1..5] OF Char;π Name2 : ARRAY[1..11] OF Char;π Unused2: ARRAY[1..9] OF Byte;π END;ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πVARπ DirInfo : SearchRec;π DirDiskID : String[12];π I,PosPeriod : Byte;πBEGINπ FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);π IF DosError = 0 THENπ BEGINπ DirDiskID := DirInfo.Name;π PosPeriod := POS('.',DirDiskID);π IF PosPeriod > 0 THENπ Delete(DirDiskID,PosPeriod,1);π GetDiskID := DirDiskIDπ ENDπ ELSEπ GetDiskID := ''πEND;ππ{Use MsDos service 16H to SET a volume label }πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π FOR I := 1 TO Length(DiskID) DOπ Name1[I] := DiskID[I];π IF Length(DiskID) < 11 THENπ FOR I := (Length(DiskID) + 1) TO 11 DOπ Name1[I] := ' 'π END;π Regs.ah := $16;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ SetDiskID := TRUEπ ELSEπ SetDiskID := FALSEπEND;ππ{use MsDOS service 17H to RENAME a volume label }πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType ;π NewDiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;ππ {Set old disk id}ππ FOR I := 1 TO Length(OldDiskID) DOπ Name1[I] := OldDiskID[I];π FOR I := (Length(OldDiskID) + 1) TO 11 DOπ Name1[I] := ' ';ππ {Set new disk id}ππ FOR I := 1 TO Length(NewDiskID) DOπ Name2[I] := NewDiskID[I];π FOR I := (Length(NewDiskID) + 1) TO 11 DOπ Name2[I] := ' 'π END;π Regs.ah := $17;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ ReNameDiskID := TRUEπ ELSEπ ReNameDiskID := FALSEπEND;ππ{Use MsDos service 13H DELETE a volume label }ππFUNCTION DeleteDiskID(Drive:DriveType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π Name1[1] := '*';π Name1[2] := '.';π Name1[3] := '*';π FOR I := 4 TO 11 DO Name1[I] := ' 'π END;π Regs.ah := $13;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ DeleteDiskID := TRUEπ ELSEπ DeleteDiskID := FALSEπEND;ππEND.π 24 07-16-9306:30ALL SWAG SUPPORT TEAM Edit Disk Serial Number IMPORT 30 ╣ª∙ PROGRAM Serial (Input, Output);πUSES CRT;ππCONSTπ HexDigits : ARRAY [0..15]OF CHAR = '0123456789ABCDEF';πTYPEπ InfoBuffer = RECORDπ InfoLevel : WORD; {should be zero}π Serial : LONGINT;π VolLabel : ARRAY [0..10]OF CHAR;π FileSystem : ARRAY [0..7]OF CHAR;π END;π SerString = STRING [9];ππVARπ IB : InfoBuffer;π N : WORD;π let : CHAR;π param : STRING [10];π IsSet : BOOLEAN;π NewSerial : LONGINT;π code : INTEGER;ππ FUNCTION SerialStr (L : LONGINT) : SerString;π VAR Temp : SerString;π BEGINπ Temp [0] := #9;π Temp [1] := HexDigits [L SHR 28];π Temp [2] := HexDigits [ (L SHR 24) AND $F];π Temp [3] := HexDigits [ (L SHR 20) AND $F];π Temp [4] := HexDigits [ (L SHR 16) AND $F];π Temp [5] := '-';π Temp [6] := HexDigits [ (L SHR 12) AND $F];π Temp [7] := HexDigits [ (L SHR 8) AND $F];π Temp [8] := HexDigits [ (L SHR 4) AND $F];π Temp [9] := HexDigits [L AND $F];π SerialStr := Temp;π END;ππ FUNCTION GetSerial (DiskNum : BYTE;π VAR I : InfoBuffer) : WORD;assembler;π asmπ MOV AH, 69hπ MOV AL, 00hπ MOV BL, DiskNumπ PUSH DSπ LDS DX, Iπ INT 21hπ POP DSπ JC @Badπ XOR AX, AXπ @Bad :π END;ππ FUNCTION SetSerial (DiskNum : BYTE;π VAR I : InfoBuffer) : WORD;assembler;π asmπ MOV AH, 69hπ MOV AL, 00hπ MOV BL, DiskNumπ PUSH DSπ LDS DX, Iπ INT 21hπ POP DSπ JC @Badπ XOR AX, AXπ @Bad :π END;ππ PROCEDURE ErrorOut (err : BYTE);π BEGINπ CASE err OFπ 5 : BEGINπ WRITELN ('Either the disk in ', let, ': is write',π 'protected or it lacks an extended BPB.');π WRITELN ('If the disk is not write-protected, ',π 'reformat it with DOS 4 or higher.');π END;π 15 : WRITELN ('Not a valid drive letter.');π 255 : BEGINπ WRITELN ('SYNTAX: SERIAL D:########"');π WRITELN (' where D: is the drive letter',π 'and ######## is the eight digit');π WRITELN (' hexadecimal serial number with-',π 'out the "-".');π WRITELN ('EXAMPLE: SERIAL A: 1234ABCD');π END;ππ ELSE WRITELN ('DOS ERROR #', N);π END;π HALT (1);π END;ππ BEGINπ CLRSCR;π IF PARAMCOUNT < 1 THEN ErrorOut (255);π IF PARAMCOUNT > 2 THEN ErrorOut (255);π param := PARAMSTR (1);π CASE LENGTH (param) OFπ 1 : {OK};π 2 : IF param [2] <> ':' THEN ErrorOut (255);π ELSE ErrorOut (255);π END;π let := UPCASE (param [1]);π IF (let < 'A') OR (let > 'Z') THEN ErrorOut (15);π IF PARAMCOUNT < 2 THEN IsSet := FALSEπ ELSEπ BEGINπ IsSet := TRUE;π param := '$' + PARAMSTR (2);π VAL (param, NewSerial, code);π IF code <> 0 THEN ErrorOut (255);π END;π N := GetSerial (ORD (let) - ORD ('@'), IB);π IF N = 0 THENπ BEGINπ WITH IB DOπ BEGINπ WRITELN ('Serial Number is "',π SerialStr (Serial), '"');π IF IsSet THENπ BEGINπ Serial :=π NewSerial; ;π N :=π SetSerial (ORD (let) - ORD ('@'), IB);π IF N = 0 THENππ WRITELN ('Successfully canged serial to "', SerialStr (NewSerial), '"')π ELSEπ ErrorOut (N);π END;π END;π ENDπ ELSE ErrorOut (N);ππ END.ππ 25 07-17-9307:29ALL LAWRENCE JOHNSTONE Disk Serial Numbers IMPORT 15 ╣"â (*πDate: 07-10-93 (02:15)πFrom: LAWRENCE JOHNSTONEπSubj: DISK'S SERIAL NUMBER.πThis will work under DOS 4.0 or later, according to Microsoft's MS-DOSπProgrammer's Reference (earlier versions of DOS didn't give disksπserial numbers).π*)ππUNIT MediaID;ππINTERFACEππTYPEπ TMediaID = RECORDπ InfoLvl: WORD;π SerialNum: LONGINT;π VolLabel: ARRAY [1..11] OF CHAR;π FileSys: ARRAY [1..8] OF CHAR;π END;ππFUNCTION GetMediaID( Drive: WORD; VAR MID: TMediaID ): BOOLEAN;π (* Drive: 0=default, 1=A, 2=B, etc. *)ππFUNCTION SetMediaID( Drive: WORD; CONST MID: TMediaID ): BOOLEAN;ππIMPLEMENTATIONππFUNCTION GetMediaID( Drive: WORD; VAR MID: TMediaID ): BOOLEAN; ASSEMBLER;π ASMπ push dsπ mov bx, [Drive]π mov ch, $08 (* Device category (must be 08h) *)π mov cl, $66 (* Minor code for Get Media ID function *)π lds dx, [MID] (* DS:DX -> TMediaID structure *)π mov ax, $440D (* Function 44 (IOCTL), subfunction 0D *)π int $21π pop dsπ mov ax, 0 (* Assume function failed *)π jc @@Doneπ inc ax (* Didn't fail -- return TRUE *)π @@Done:π END;ππFUNCTION SetMediaID( Drive: WORD; CONST MID: TMediaID ): BOOLEAN; ASSEMBLER;π ASMπ push dsπ mov bx, [Drive]π mov ch, $08 (* Device category (must be 08h) *)π mov cl, $46 (* Minor code for Set Media ID function *)π lds dx, [MID] (* DS:DX -> TMediaID structure *)π mov ax, $440D (* Function 44 (IOCTL), subfunction 0D *)π int $21π pop dsπ mov ax, 0 (* Assume function failed *)π jc @@Doneπ inc ax (* Didn't fail -- return TRUE *)π @@Done:π END;πππEND.ππ 26 08-17-9308:42ALL SWAG SUPPORT TEAM FCBLABELS - Disk Serial IMPORT 51 ╣J UNIT FCBLabel;π{Turbo Pascal unit for manipulating volume labels}ππINTERFACEπUSESπ DOS;πTYPEπ DriveType = String[1];π DiskIDType = String[11];ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType;π NewDiskID:DiskIDType): Boolean;πFUNCTION DeleteDiskID(Drive:DriveType): Boolean;ππIMPLEMENTATIONπTYPEπ ExtendedFCBRecord = RECORDπ ExtFCB : Byte;π Res1 : ARRAY[1..5] OF Byte;π Attr : Byte;π Drive : Byte;π Name1 : ARRAY[1..11] OF Char;π Unused1: ARRAY[1..5] OF Char;π Name2 : ARRAY[1..11] OF Char;π Unused2: ARRAY[1..9] OF Byte;π END;ππFUNCTION GetDiskID(Drive:DriveType): DiskIDType;πVARπ DirInfo : SearchRec;π DirDiskID : String[12];π I,PosPeriod : Byte;πBEGINπ FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);π IF DosError = 0 THENπ BEGINπ DirDiskID := DirInfo.Name;π PosPeriod := POS('.',DirDiskID);π IF PosPeriod > 0 THENπ Delete(DirDiskID,PosPeriod,1);π GetDiskID := DirDiskIDπ ENDπ ELSEπ GetDiskID := ''πEND;ππ{Use MsDos service 16H to SET a volume label }πFUNCTION SetDiskID(Drive:DriveType;π DiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π FOR I := 1 TO Length(DiskID) DOπ Name1[I] := DiskID[I];π IF Length(DiskID) < 11 THENπ FOR I := (Length(DiskID) + 1) TO 11 DOπ Name1[I] := ' 'π END;π Regs.ah := $16;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ SetDiskID := TRUEπ ELSEπ SetDiskID := FALSEπEND;ππ{use MsDOS service 17H to RENAME a volume label }πFUNCTION ReNameDiskID(Drive:DriveType;π OldDiskID:DiskIDType ;π NewDiskID:DiskIDType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;ππ {Set old disk id}ππ FOR I := 1 TO Length(OldDiskID) DOπ Name1[I] := OldDiskID[I];π FOR I := (Length(OldDiskID) + 1) TO 11 DOπ Name1[I] := ' ';ππ {Set new disk id}ππ FOR I := 1 TO Length(NewDiskID) DOπ Name2[I] := NewDiskID[I];π FOR I := (Length(NewDiskID) + 1) TO 11 DOπ Name2[I] := ' 'π END;π Regs.ah := $17;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ ReNameDiskID := TRUEπ ELSEπ ReNameDiskID := FALSEπEND;ππ{Use MsDos service 13H DELETE a volume label }ππFUNCTION DeleteDiskID(Drive:DriveType): Boolean;πVARπ FCB : ExtendedFCBRecord;π Regs : Registers;π Temp : String[1];π I : Integer;πBEGINπ Temp := Drive;π WITH FCB DOπ BEGINπ ExtFCB := $FF;π Attr := $8;π Drive := Ord(UpCase(Temp[1])) - 64;π Name1[1] := '*';π Name1[2] := '.';π Name1[3] := '*';π FOR I := 4 TO 11 DO Name1[I] := ' 'π END;π Regs.ah := $13;π Regs.ds := Seg(FCB);π Regs.dx := Ofs(FCB);π MsDos(Regs);π IF Regs.AL = 0 THENπ DeleteDiskID := TRUEπ ELSEπ DeleteDiskID := FALSEπEND;ππEND.ππ{ --------------- TEST PROGRAM -------------------}πππPROGRAM TestFCB;ππ{ test FCBLabel UNIT}ππUSES CRT,FCBLabel;ππVARπ Choice : Byte;π Drive : DriveType;π DiskID : DiskIDType;π NewDiskID : DiskIDType;ππBEGINπ REPEAT {Endless loop - select option 5 to Exit}π ClrScr;π GotoXY(25,1); WriteLn('Volume Functions');π GotoXY(25,9); WriteLn('1) SET LABEL');π GotoXY(25,10); WriteLn('2) DELETE LABEL');π GotoXY(25,11); WriteLn('3) RENAME LABEL');π GotoXY(25,12); WriteLn('4) GET LABEL');π GotoXY(25,13); WriteLn('5) Exit');π GotoXY(20,15);π Write('Type number and press Enter > ');π ReadLn(Choice); WriteLn;π Drive := 'C'; { use drive C: as test drive }ππ CASE Choice OFπ 1: BEGIN {Set volume LABEL}π DiskID := GetDiskID(Drive);π IF DiskID <> '' THENπ BEGINπ WriteLn('Label not null: ',DiskID);π WriteLn('Use RENAME instead');π WriteLn('Press Enter to continue');π ReadLnπ ENDπ ELSEπ BEGINπ Write('Enter new label > ');π ReadLn(DiskID);π IF NOT SetDiskID(Drive,DiskID) THENπ BEGINπ WriteLn('System Error');π WriteLnπ ('Press Enter to continue');π ReadLnπ ENDπ ENDπ END;π 2: BEGIN {Delete Volume LABEL}π IF DeleteDiskID(Drive) THENπ WriteLn('Volume label deleted')π ELSEπ WriteLn('System Error');π WriteLn('Press Enter to continue');π ReadLnπ END;π 3: BEGIN {Rename Volume LABEL}π DiskID := GetDiskID(Drive);π IF DiskID = '' THENπ BEGINπ WriteLn('Current label is null:');π WriteLn('Use SET option instead');π WriteLn('Press Enter to continue');π ReadLnπ ENDπ ELSEπ BEGINπ Write('Enter new name of label > ');π ReadLn(NewDiskID);π IF NOT ReNameDiskIDπ (Drive,DiskID,NewDiskID) THENπ BEGINπ WriteLn('System Error');π WriteLnπ ('Press Enter to continue');π ReadLnπ ENDπ ENDπ END;π 4: BEGIN {Get Volume LABEL}π DiskID := GetDiskID(Drive);π Write('The current label is ');π IF DiskID = '' THENπ WriteLn('null')π ELSEπ WriteLn(DiskID);π WriteLn('Press Enter to continue');π ReadLnπ END;π 5: Halt;π ELSE { continue }π END { case }π UNTIL FALSEπEND.π 27 08-17-9308:47ALL JAN DOGGEN Disk Parking IMPORT 19 ╣Qc ===========================================================================π BBS: Canada Remote SystemsπDate: 07-11-93 (20:49) Number: 30503πFrom: JAN DOGGEN Refer#: NONEπ To: MARK STEPHEN Recvd: NO πSubj: RE: PARK IT! Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Mark Stephen to Herb Brown <=-ππ HB> Anybody have any suggestions, experiences, trials, tribulations,π HB> videos, and/or code examples on how to park a hard drive?ππ MS> Trouble is, I have no idea of how to find out if the code has actuallyπ MS> done what I want it to, and there seems to be a real possibility ofππ Yep, took me some time to figure out you can't test where the head isπ (i.e. if the park was succesful).π I always assume that it won't do any harm on self-parking drivesπ (they just park twice).π Here's some code for Herb too; I guess he reads this too.ππPROCEDURE ParkDisk;π VAR Regs: Registers;π BEGINπ Regs.AH := $08; { 'Return drive parameters' function }π Regs.DL := $80; { Physical drive number - first hard disk }π Regs.AL := $00;π Intr($13,Regs);π Assert((Regs.Flags AND FCarry) = 0,π 'Error getting disk parameters - AL returns '+IntToStr(Regs.AL,0));π { Now: DL = Number of drives responding }π { DH = Maximum head number (# heads - 1) }π { CH = Maximum cylinders/tracks (# tracks - 1) - lower 8 bits }π { CL = Higher 2 bits: high 2 bits of max cyl/tr }π { Lower 6 bits: Maximum sector number }π { We now position the heads using the BIOS Seek service. We can use }π { the returned registers again if we set DL back to $80. }π Regs.AH := $0C;π Regs.DL := $80;π Intr($13,Regs);π Assert((Regs.Flags AND FCarry) = 0,π 'Error parking disk - AL returns '+IntToStr(Regs.AL,0));π END; { ParkDisk }ππ MS> How about ignoring the problem, and if trouble develops, blaming it onπ MS> the hardware? (I believe this is the traditional approach?) The codeππ Some approach!ππ Janπ___ Blue Wave/QWK v2.10ππ--- Maximus 2.01π * Origin: *** DOSBoss Zuid *** (2:500/131)π 28 08-18-9312:20ALL JOSE ALMEIDA Get Device Type IMPORT 15 ╣è{ { Gets the device type.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππPROCEDURE dpDevType(Drive : byte;π var Device_Type : byte;π var Error_Code : byte);ππ{ DESCRIPTION:π Gets the device type.π SAMPLE CALL:π dpDevType(1,Device_Type,Error_Code);π ON ENTRY:π Drive:π 1 : drive A:π 2 : drive B:π and so on...π RETURNS:π Device_Type :π 0 : 320/360 KBytes floppyπ 1 : 1.2 MBytes floppyπ 2 : 720 KBytes floppyπ 3 : 8" single density floppyπ 4 : 8" double density floppyπ 5 : hard diskπ 6 : tape driveπ 7 : 1.44 MBytes floppyπ 8 : read/write optiocal diskπ 9 : 2.88 MBytes floppyπ else : unknown device typeπ Error_Code:π 0 : no errorπ else : error number (see The PC Programmers Source Book 3.191)π NOTES:π Applies to all DOS versions beginning with v3.3.π See dpDevType_Text() in order to get a string text. }ππvarπ TmpA : array[0..31] of byte;π HTregs : registers;ππBEGIN { dpDevType }π HTregs.AX := $440D;π HTregs.BX := word(Drive);π HTregs.CX := $0860;π HTregs.DX := Ofs(TmpA);π HTregs.DS := Seg(TmpA);π MsDos(HTregs);π if HTregs.Flags and FCarry <> 0 thenπ beginπ Device_Type := $FF; { on error returns unknown device type }π Error_Code := HTregs.ALπ endπ elseπ beginπ Device_Type := TmpA[1];π Error_Code := 0;π end;πEND; { dpDevType }π 29 08-18-9312:23ALL JOSE ALMEIDA Check for diskettes IMPORT 8 ╣sî { Cheks if there are diskettes drives present.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Diskettes_Present : boolean;π{ DESCRIPTION:π Cheks if there are diskettes drives present.π SAMPLE CALL:π B := Diskettes_Present;π RETURNS:π TRUE : There are diskettes drivesπ FALSE : There aren't diskettes drives }ππBEGIN { Diskettes_Present }π Diskettes_Present := (MemW[$0000:0410] and $0001) <> 0;πEND; { Diskettes_Present }π 30 08-18-9312:23ALL JOSE ALMEIDA Get number of fixed disksIMPORT 7 ╣ù▀ { Gets the number of fixed disks attached to the system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Fixed_Disks : byte;π{ DESCRIPTION:π Gets the number of fixed disks attached to the system.π SAMPLE CALL:π NB := Fixed_Disks;π RETURNS:π The numbers of fixed disks attached to the system. }ππBEGIN { Fixed_Disks }π Fixed_Disks := Mem[$0000:$0475];πEND; { Fixed_Disks }π 31 08-18-9312:24ALL JOSE ALMEIDA Get first CD-ROM Drive IMPORT 8 ╣ Ñ { Gets the first installed CD-ROM drive letter in a system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION First_CD_ROM_Drive : byte;π{ DESCRIPTION:π Gets the first installed CD-ROM drive letter in a system.π SAMPLE CALL:π NB := First_CD_ROM_Drive;π RETURNS:π 0 : drive Aπ 1 : drive Bπ and so on... }ππvarπ HTregs : registers;ππBEGIN { First_CD_ROM_Drive }π HTregs.AX := $1500;π HTregs.BX := $0000;π Intr($2F,HTregs);π First_CD_ROM_Drive := HTregs.CL;πEND; { First_CD_ROM_Drive }π 32 08-18-9312:24ALL JOSE ALMEIDA Get Number of CD-ROMS IMPORT 8 ╣- { Gets the number of installed CD-ROM drives in a system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION CD_ROM_Units : byte;ππ{ DESCRIPTION:π Gets the number of installed CD-ROM drives in a system.π SAMPLE CALL:π NB := CD_ROM_Units;π RETURNS:π 0 : driver not installedπ else : number of CD-ROM units }ππvarπ HTregs : registers;ππBEGIN { CD_ROM_Units }π HTregs.AX := $1500;π HTregs.BX := $0000;π Intr($2F,HTregs);π CD_ROM_Units := HTregs.BL;πEND; { CD_ROM_Units }π 33 08-18-9312:25ALL JOSE ALMEIDA Get Current Drive Number IMPORT 7 ╣I± { Gets the current drive number.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Get_Default_Drive : byte;π{ DESCRIPTION:π Gets the current drive number.π SAMPLE CALL:π NB := Get_Default_Drive;π RETURNS:π A = 0, B = 1, C = 2, etc. }ππvarπ HTregs : registers;ππBEGIN { Get_Default_Drive }π HTregs.AH := $19;π MsDos(HTregs);π Get_Default_Drive := HTregs.ALπEND; { Get_Default_Drive }π 34 08-18-9312:26ALL JOSE ALMEIDA Get Installed diskettes IMPORT 8 ╣ Ñ { Gets the number of installed diskette drives in a system.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Installed_Diskettes : byte;π{ DESCRIPTION:π Gets the number of installed diskette drives in a system.π SAMPLE CALL:π NB := Installed_Diskettes;π RETURNS:π The number of installed diskette drives. }ππBEGIN { Installed_Diskettes }π Installed_Diskettes := Succ((MemW[$0000:0410] shl 8) shr 14);πEND; { Installed_Diskettes }π 35 08-18-9312:26ALL JOSE ALMEIDA Get the BOOT Drive IMPORT 7 ╣I± { Gets the startup (boot) drive.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Startup_Drive : byte;π{ DESCRIPTION:π Gets the startup (boot) drive.π SAMPLE CALL:π NB := Startup_Drive;π RETURNS:π 1 : drive Aπ 2 : drive Bπ and so on... }ππvarπ HTregs : registers;ππBEGIN { Startup_Drive }π HTregs.AX := $3305;π MsDos(HTregs);π Startup_Drive := HTregs.DL;πEND; { Startup_Drive }π 36 08-18-9312:26ALL JOSE ALMEIDA Set Current Drive Number IMPORT 7 ╣ä┘ { Sets the current drive number.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππPROCEDURE Set_Default_Drive(D : byte);π{ DESCRIPTION:π Sets the current drive number.π SAMPLE CALL:π Set_Default_Drive(1);π RETURNS:π Nothing.π NOTES:π A = 0, B = 1, C = 2, etc. }ππvarπ HTregs : registers;ππBEGIN { Set_Default_Drive }π HTregs.AH := $0E;π HTregs.DL := D;π MsDos(HTregs);πEND; { Set_Default_Drive }π 37 08-18-9312:26ALL JOSE ALMEIDA Get Disk Verify State IMPORT 7 ╣É┘ { Gets disk verify state flag.π Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.π Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.π I can also be reached at RIME network, site ->TIB or #5314.π Feel completely free to use this source code in any way you want, and, ifπ you do, please don't forget to mention my name, and, give me and Swag theπ proper credits. }ππFUNCTION Verify_State : boolean;π{ DESCRIPTION:π Gets disk verify state flag.π SAMPLE CALL:π B := Verify_State;π RETURNS:π TRUE = on: verify after writeπ FALSE = off: no verify after write }ππvarπ HTregs : registers;ππBEGIN { Verify_State }π HTregs.AH := $54;π MsDos(HTregs);π Verify_State := HTregs.AL = $01;πEND; { Verify_State }π 38 08-27-9320:16ALL BO BENDTSEN Getting BIG Drive Size IMPORT 11 ╣╓ {πBO BENDTSENππMany people don't think about it, but DOS is limited to report more thanπ1 gigabyte. I have a 1.3 and a 1.0 gig, and made these routines for myπprograms for knowing if the drive size is more than 1 gig. Using the normalπDiskSize and DiskFree could get you strange result, sometimes it could reportπmaybe 100MB when it is really 1 gig.ππIf the size of free space is 1 you can assume that the drive is more than 1πgigabyte.π}ππFunction DriveSize(d : byte) : Longint; { -1 not found, 1=>1 Giga }πVarπ R : Registers;πBeginπ With R Doπ Beginπ ah := $36;π dl := d;π Intr($21, R);π If AX = $FFFF Thenπ DriveSize := -1 { Drive not found }π Elseπ If (DX = $FFFF) or (Longint(ax) * cx * dx = 1073725440) Thenπ DriveSize := 1π Elseπ DriveSize := Longint(ax) * cx * dx;π End;πEnd;ππFunction DriveFree(d : byte) : Longint; { -1 not found, 1=>1 Giga }πVarπ R : Registers;πBeginπ With R Doπ Beginπ ah := $36;π dl := d;π Intr($21, R);π If AX = $FFFF Thenπ DriveFree := -1 { Drive not found }π Elseπ If (BX = $FFFF) or (Longint(ax) * bx * cx = 1073725440) Thenπ DriveFree := 1π Elseπ DriveFree := Longint(ax) * bx * cx;π End;πEnd;π 39 08-27-9320:50ALL ROB GREEN Last Drive IMPORT 6 ╣ ▓ {πROB GREENππ> do any of you guys know how to figure out which drive is the last driveπ> on someone's system? I was think of making a drive With Dos'sπ}ππUsesπ Dos;ππFunction driveexist(ch : Char) : Boolean;πbeginπ DriveExist := disksize(ord(upcase(ch)) - 64) <> - 1;πend;πππ{ Kerry Sokalsky }ππConstπ exist : Boolean = True;π ch : Integer = 67; { 'C' - Skip floppy Drives (A&B) }π lastdrive : Char = ' ';ππbeginπ While LastDrive = ' ' doπ beginπ if driveexist(Chr(ch)) thenπ Inc(Ch)π elseπ LastDrive := Chr(Ch - 1);π end;ππ Writeln(LastDrive);πend.ππ 40 08-27-9321:57ALL PETER KLAPPROTH Disk Serial Numbers IMPORT 9 ╣h {πPETER KLAPPROTHππ> If anyone happens to know how to find the serial numberπ> of a diskette, please let me know, code is nice :)π> It is stored in byte 42, 41, 40, and 39 (counting the first one asπ> 0) of ths first sector of the disk. The code I have for it uses theπ> TPro package to read the sector.ππannother way to read/write the diskId is the following small peace of code.π}ππtypeπ TInfoBuffer = recordπ InfoLevel : word; {may be 0}π Serial : longInt;π VolLabel : array [0..10] of char;π FileSystem: array [0..7] of char;π end;ππfunction GetSerial(DiskNum : Byte; var I : TInfoBuffer) : word; assembler;πasmπ mov ah, 69hπ mov al, 00hπ mov bl, DiskNumπ push dsπ lds dx, Iπ int 21hπ pop dsπ jc @badπ Xor ax, axπ @bad:πend;ππfunction SetSerial(DiskNum : Byte; var I : TInfoBuffer) : word; assembler;πasmπ mov ah, 69hπ mov al, 01hπ mov bl, DiskNumπ push dsπ lds dx, Iπ int 21hπ pop dsπ jc @badπ xor ax, axπ @bad:πend;ππ 41 09-26-9308:47ALL MARTIN RICHARDSON Bytes per sector on disk IMPORT 7 ╣f% {*****************************************************************************π * Function ...... BytesPerSector()π * Purpose ....... To return the number of bytes per sector of a diskπ * Parameters .... nDrive Drive containing diskπ * Returns ....... The number of bytes per sector of the specified diskπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π *****************************************************************************}πFUNCTION BytesPerSector( nDrive: BYTE ): INTEGER;πVAR π Regs: Registers;πBEGINπ Regs.AH := $1C;π Regs.DL := nDrive;π MSDOS( Regs );π BytesPerSector := Regs.AL * Regs.CX;πEND;ππ 42 09-26-9309:27ALL MARTIN RICHARDSON Set the current Drive IMPORT 11 ╣"k {****************************************************************************π * Procedure ..... SetDrive()π * Purpose ....... To set the current driveπ * Parameters .... i Drive number to change to (0=A, 1=B, 2=C, etc.)π * Returns ....... N/Aπ * Notes ......... Noneπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π ****************************************************************************}πPROCEDURE SetDrive( i : INTEGER ); ASSEMBLER;πASMπ MOV AH, 0Ehπ MOV DL, BYTE PTR iπ INT 21hπEND;ππ{****************************************************************************π * Procedure ..... SetCDrive()π * Purpose ....... To set the current driveπ * Parameters .... c Drive letter to change toπ * Returns ....... N/Aπ * Notes ......... Same as SetDrive, but you pass the drive letter instead ofπ * number.π * . Uses function SetDriveπ * Author ........ Martin Richardsonπ * Date .......... May 13, 1992π ****************************************************************************}πPROCEDURE SetCDrive( c :CHAR );πBEGINπ IF ( c IN ['A'..'Z'] ) THENπ SetDrive( POS( c, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ) - 1 );πEND;ππ 43 09-26-9310:11ALL CHRIS PRIEDE Hard Drive Report IMPORT 18 ╣àÜ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 09-20-93 (01:47) Number: 8840πFrom: CHRIS PRIEDE Refer#: NONEπ To: WIM VAN.VOLLENHOVEN Recvd: NOπSubj: Disk & Drives Conf: (1617) L-Pascalπ---------------------------------------------------------------------------πWV> - I can't figure out how to determain if the drive is a ramdiskπWV> or a fixed disk.ππ RAM disks have only one copy of FAT, while floppies and hard disksπshould have at least two. Use DOS function 1Fh or 32h to get thisπinformation for current/specified drive. The following program usesπfunction 1F:ππ===========================================================π*)ππprogram TellMeAllAboutMyDrive;π(* Released to public domain, K. Priede, 1993 *)ππuses Dos;ππtypeπ (* record matching DOS (2.0+) Drive Parameter Block.π * defined only interesting items, DOS structure is bigger *)π DosDPB = recordπ Drive, UnitNo: byte;π BytesPerSector: word;π LastSectorInCluster: byte;π ShiftCount: byte;π ReservedSectors: word;π FATCount: byte;π RootDirEntries, FirstDataSector, LastCluster: word;π end;ππvarπ Regs: Registers;ππbeginπ (* func. 1Fh -- Get DPBπ * returns: AL = 0 if successful, DS:BX -> DBP *)π Regs.AH := $1F;π MsDos(Regs);π (* now show what we got ... *)π if Regs.AL = 0 thenπ with DosDPB(Ptr(Regs.DS, Regs.BX)^) doπ beginπ Writeln(#10#13'Parameters for drive ',π Chr(Ord('A') + Drive), ':'#13#10);π Writeln('Sector size: ':24, BytesPerSector, ' bytes');π Writeln('Sectors per cluster: ':24, LastSectorInCluster +1);π Writeln('Clusters on drive: ':24, LastCluster -1);π Writeln('Total drive space: ':24, longint(BytesPerSector) *π (LastSectorInCluster +1) * (LastCluster -1),' bytes'#13#10);π Writeln('Number of FATs: ':24, FATCount);π Writeln('Root directory size: ':24, RootDirEntries, ' entries');π endπ else Writeln('Error!');πend.π===========================================================π---π ■ RNET 2.00m: ILink: Faster-Than-Light ■ Atlanta GA ■ 404-296-3120 / 299-3930π 44 09-26-9310:11ALL KENT BRIGGS Available Drives IMPORT 14 ╣àÜ (*π===========================================================================π BBS: Canada Remote SystemsπDate: 08-29-93 (15:41) Number: 36579πFrom: KENT BRIGGS Refer#: NONEπ To: HOWARD HUANG Recvd: NOπSubj: CHECK AVAILABLE DRIVES Conf: (1221) F-PASCALπ---------------------------------------------------------------------------π -=> Quoting Howard Huang to All <=-ππ HH> Does anyone know how to check if a drive is valid without accessingπ HH> it to see? For example, if the available drives on a system are: A, B,π HH> C, E. How do you check if drive A is installed without having theπ HH> floppy drive lights go on. I use TP6, so if you include a sample code,π HH> could you make it compatible with it.ππ Howard, here's what I use:π*)πprogram show_drives;πuses dos;πvarπ reg: registers;π drv: array[1..3] of byte;π drvlist: string[26];π fcb: array[1..37] of byte;π i: integer;πbeginπ drvlist:='';π for i:=1 to 26 do {Try drives A..Z}π beginπ drv[1]:=i+64; {A=ASCII 65, etc}π drv[2]:=ord(':');π drv[3]:=0;π reg.ax:=$2906; {DOS function 29h = Parse Filename}π reg.si:=ofs(drv[1]); {Point to drive string}π reg.di:=ofs(fcb[1]); {Point to File Control Block}π reg.ds:=dseg;π reg.es:=dseg;π msdos(reg); {DOS Interrupt}π if reg.al<>$ff then drvlist:=drvlist+chr(i+64);π end;π writeln('Available drives = ',drvlist);πend.ππ___ Blue Wave/QWK v2.12π--- Renegade v07-17 Betaπ * Origin: Snipe's Castle BBS, Waco TX (817)-757-0169 (1:388/26)π 45 10-28-9311:30ALL DJ MURDOCK DISK Light IMPORT 8 ╣àÜ (*π=========================================================================πDate: 10-02-93 (19:15)πFrom: D.J. MurdochπSubj: Flashing The Disk Lightπ=========================================================================ππTHIS IS SAFE !!!! All it does is turn the disk light ON/OFF. Shouldπonly be used on Floppy drives.ππ*)ππUSES Crt;ππprocedure turn_on_motor(drive:byte);π{ Remember to wait about a half second before trying to read! }πbeginπ port[$3F2] := 12 + drive + 1 SHL (4 + drive);πend;ππprocedure turn_off_motor(drive:byte);π{ drive A = 0, drive B = 1 }πbeginπ port[$3F2] := 12 + drive;πend;ππVAR I : BYTE;ππBEGINππFOR I := 1 TO 10 DO { let's make 'A' and 'B' flash for awhile }π BEGInπ Turn_On_Motor(0);π Delay(100);π Turn_Off_Motor(0);π Delay(100);π Turn_On_Motor(1);π Delay(100);π Turn_Off_Motor(1);π Delay(100);π END;πEND.ππ 46 10-28-9311:30ALL BRAIN PAPE Is DISK Ready ?? IMPORT 24 ╣ª╢ {===========================================================================πDate: 10-03-93 (00:14)πFrom: BRIAN PAPEπSubj: disk readyπ---------------------------------------------------------------------------πDoes anyone know if there is any better (and FASTER!) way to tell if aπdisk drive is ready? I wrote a function yesterday to do that by callingπthe BIOS Read Track interrupt. The only problem is that it has toπactually read from the disk, and it is rather slow, especially on slowerπcomputers.ππHere is my code: }ππ{ NOTE :ππ Added a BOOLEAN function and added Reset DRIVE GDAVIS 10/15/93}ππUSES CRT;ππVARπ Buf : ARRAY[0..512] OF BYTE; { Buffer MUST be outside }ππfunction diskstatus(drive:byte):byte; assembler; { drive is A=0, B=1 etc}πasmπ cmp drive,26π jb @driveokπ mov drive,0 { if drive isn't between 0 and 25, make it 0 (for A:) }π @driveok:ππ mov ax, seg bufπ mov es, axπ mov bx, offset bufππ mov ah, 02 { read disk sectors }π mov al, 1 { number of sectors to transfer }π mov ch, 1 { track number }π mov cl, 1 { sector number }π mov dh, 1 { head number }π mov dl, drive { drive number (0=A, 3=C, or 80h=C, 81h=D) }π int 13hππ mov bl,0 { assume drive is ready }π jnc @done { carry set if unsuccessfull (i.e. disk is not ready) }π mov bl,ahπ jmp @doneππ { take out the above two lines to make this just checkπ for disk ready/not ready }ππ and ah,$80π jz @done { error was something other than disk not ready }π mov bl,false{ disk wasn't ready. store result }π @done:ππ mov ax,$0000 { reset drive }π INT 13Hππ xor ax,ax { shut off disk drive quickly }π mov es,axπ mov ax,440hπ mov di,axπ mov byte ptr es:[di],01hππ mov al,bl { retrieve result }πend; { diskstatus }πππfunction diskready(drive:CHAR):BOOLEAN; assembler;πasmπ cmp drive,'a'π jb @isupcase { make it UPPER case }π sub drive,20Hπ @isupcase:π cmp drive,'Z'π jb @driveokπ mov drive,'A' { if drive isn't between 'A' and 'Z', make it A) }π @driveok:π mov ax, seg bufπ mov es, axπ mov bx, offset bufππ mov ah, 02 { read disk sectors }π mov al, 1 { number of sectors to transfer }π mov ch, 1 { track number }π mov cl, 1 { sector number }π mov dh, 1 { head number }ππ mov dl, driveπ sub dl, 'A' { subtract ORD of 'A' }ππ {mov dl, drive { drive number (0=A, 3=C, or 80h=C, 81h=D) }π int 13hππ mov bl,true { assume drive is ready }π and ah,$80π jz @done { error was something other than disk not ready }π mov bl,false{ disk wasn't ready. store result }π @done:ππ mov ax,$0000 { reset drive }π INT 13Hππ xor ax,ax { shut off disk drive quickly }π mov es,axπ mov ax,440hπ mov di,axπ mov byte ptr es:[di],01hππ mov al,bl { retrieve result }πend; { diskready }ππBEGINπClrScr;πWriteLn(DiskStatus(0));πWriteLn(DiskReady('a')); { case ain't significant }πreadkey;πEND. 47 10-28-9311:30ALL GAYLE DAVIS EXISTDD Update IMPORT 31 ╣ê { Updated DRIVES.SWG on October 13, 1993 }ππ{ This give all the info on a bootable drive }π{ it replaces the EXIST-DD in DRIVES.SWG which DID NOT work }π{ updated by GDAVIS 10/13/93 }ππUsesπ Crt,Dos;ππTypeπ bootrecptr = ^bootRecord;π bootRecord = Recordπ nj : Array[0..2] of Byte; {offset 0 Near jump code }π oem : Array[0..7] of Byte; { 3 OEM name and ver }π Bytesec : Word; { 11 Bytes/Sector }π sectclus : Byte; { 13 Sectors/cluster }π ressect : Word; { 14 Reserved sectors }π fattables: Byte; { 16 FAT tables }π direntrys: Word; { 17 Directory entries}π logsec : Word; { 19 Logical sectors }π MDS : Byte; { 21 Media descriptor }π FatSects : Word; { 22 FAT sectors }π Secstrak : Word; { 24 Sectors/track }π NumHeads : Word; { 26 Number of heads }π HidnSecs : Word; { 28 Hidden sectors }π bootcode : Array[0..415] of Byte; { 30 boot code }π partcode : Array[0..15] of Byte; { 446 partition info }π bootcode2: Array[0..49] of Byte; { 462 rest of boot code}π end;ππVarπ boot : bootRecord; { the boot Record Variable }ππ FUNCTION DiskRead (Drive : CHAR; SSect, NSect : WORD; VAR Buffer) : WORD;π { Read absolute disk sectors }ππ VARπ kbuff : ARRAY [0..$1f] OF BYTE; {Read Ralf Brown's interrupt listing}π kPtr : POINTER; {Int 25h - ES:[BP+1E] may change }π bufPtr : POINTER;ππ BEGINππ kPtr := @kbuff;π BufPtr := @buffer;ππ Asmπ push esπ push bpπ push diπ les di, kPtr { move past first 31 bytes }π mov al, drive { Gets the passed parameter. }π AND al, 1fh { Cvt from ASCII to drive num }π DEC al { Adjust because A: is drive 0 }π mov cx, nsect { number of sectors to read }π mov dx, ssect { starting at sector.. }π push dsπ lds bx, bufptr { Get the address of the buffer }π mov bp, diπ push siπ INT 25h { Do the drive read. }π pop si { Remove the flags int 25h leaves on stack}π pop siπ pop dsπ pop diπ pop bpπ pop esπ jc @1π mov @result, 0 { No errors, so set Function to zero }π jmp @Escapeπ @1 :π mov @result, axππ @Escape :π END;π END;ππProcedure bootlook(Drive : Char);πVarπ ReadResult : WORD;π I : Integer;πbeginπ { Get diskette info }π ReadResult := DiskRead(Drive,0,1,boot);π if ReadResult <> 0 thenπ beginπ { Error code here , there are LOTS of them.. see a good DOS bookπ most common will be :π 2 = Drive NOT readyπ 7 = unknown media .. not a boot diskπ 8 = sector not found .. not a boot disk }π Writeln(LO(ReadResult));π endπ elseπ beginπ WITH Boot DOπ BEGINπ { I'll just print a few of the possible items }π Write('OEM : ');π FOR I := 0 TO 7 DO WRITE(CHR(OEM[i]));π Writeln;π WriteLn('Dir Entrys : ',DirEntrys : 4);π WriteLn('Fat Tables : ',FatTables : 4);π WriteLn('Num Heads : ',NumHeads : 4);π WriteLn('Secs p/Trk : ',SecsTrak : 4);π WriteLn('Hidden Secs : ',HidnSecs : 4);π END;π end;ππend; { Procedure bootlook }ππBEGINπClrScr;πBootLook('B'); { if drive isn't bootable, you'll get an error (7) }πReadkey; { try it, this is a safe procedure }πEND.π 48 10-28-9311:37ALL JON JASIUNAS DISK SERIAL IMPORT 12 ╣o╜ {===========================================================================πDate: 08-22-93 (01:50) Number: 35568πFrom: JON JASIUNAS Refer#: NONEπSubj: SERIAL # OF DISK Conf: (1221) F-PASCALπ--------------------------------------------------------------------------- }ππ Uses DOS, CRT;π Type MIDRecord = Recordπ InfoLevel : Word;π SerialNum : LongInt; {This is the serial number...}π VolLabel : Array[1..11] of Char;π FatType : Array[1..8] of Char;π End;πFunction Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;πVar Result : Word;πVar Regs : Registers;πBeginπ FillChar(Mid,SizeOf(Mid),0);π FillChar(Regs,SizeOf(Regs),0);π With Regs DOπ Beginπ AX := $440D;π BX := Drive;π CX := $0866;π DS := Seg(Mid);π DX := Ofs(Mid);π Intr($21,Regs);π Case AX ofπ $01 : Label_Fat := False;π $02 : Label_Fat := False;π $05 : Label_Fat := False;π Else Label_Fat := True;π End;π End;πEnd;ππVar Mid : MidRecord;πBeginπ ClrScr;π If Label_Fat(Mid,0) Thenπ With Mid DOπ Beginπ Writeln(SerialNum);π Writeln(VolLabel);π Writeln(FatType);π Endπ Else Writeln('Error Occured');πEnd.ππ 49 11-02-9304:52ALL KENT BRIGGS Available Drives IMPORT 10 ╣Sü {πKENT BRIGGSππ> Does anyone know how to check if a drive is valid Without accessingπ> it to see? For example, if the available drives on a system are: A, B,π> C, E. How do you check if drive A is installed Without having theπ> floppy drive lights go on. I use TP6, so if you include a sample code,π> could you make it compatible With it.π}ππProgram Show_drives;ππUsesπ Dos;ππVarπ Drv : Array [1..3] of Byte;ππProcedure ReportDrives;πVarπ Regs : Registers;π Count : Integer;π DrvList : String[26];π Fcb : Array [1..37] of Byte;πbeginπ DrvList := '';π For Count := 1 to 26 do {Try drives A..Z}π beginπ Drv[1] := Count + 64; {A=ASCII 65, etc}π Drv[2] := Ord(':');π Drv[3] := 0;π Regs.AX := $2906; {Dos Function 29h = Parse Filename}π Regs.SI := Ofs(Drv[1]); {Point to drive String}π Regs.DI := Ofs(Fcb[1]); {Point to File Control Block}π Regs.DS := DSeg;π Regs.ES := DSeg;π MsDos(Regs); {Dos Interrupt}π if Regs.AL <> $FF thenπ DrvList := DrvList + Chr(Count + 64);π end;π Writeln('Available drives = ', DrvList);πend;ππbeginπ ReportDrives;πend.ππ 50 11-02-9305:01ALL MAYNARD PHILBROOK Editing the BOOT Sector IMPORT 9 ╣2 {πMAYNARD PHILBROOKππ> How can I look With a pascal-Program(I have TP7.0)in the boot-sectorπ> of a disk and change them?π}ππUsesπ Dos;ππVarπ Sector : Array [1..512] of Byte;π Regs : Registers;ππFunction Read_Boot_Sector(Var Drive : Byte) : Boolean;πbeginπ With Regs doπ beginπ AH := $02; { Function Number Read_Sector }π AL := 1; { Number of Sectors to Read }π CH := 1; { Cylender Number, Upper 2 Bits used For HD }π CL := 0; { Bios use Zero base Numbers here }π DH := 0; { Head Number or Side 0 = side 1 }π DL := Drive; { 0 = A:, 1 := B: Floppys, Add $80 For Fisk Disk }π ES := Seg(Sector); { Pass the Address of Buffer }π BX := Ofs(Sector);π Intr($13, Regs); { Call Bios Int ); }π if Flags and $01 <> 0 Thenπ Read_Boot_Sector := Falseπ elseπ Read_Boot_Sector := True;π end;πend;ππbeginπ if Read_Boot_Sector(0) Thenπ WriteLn(' Got it ')π elseπ WriteLn(' Disk Error in reading ');πend.π 51 11-02-9305:06ALL WIM VAN VOLLENHOVEN Detecting CD-ROM IMPORT 5 ╣█[ {πWIM VAN VOLLENHOVENππ>No, I'm looking for an generic CD-ROM detection routine.π>Thought it was some subfunction of int 2Fh. Don't know if it detectedπ>the presence of a CD-Rom, or the presence of MSCDEX.π}πUsesπ Dos;ππVarπ Regs : Registers;ππProcedure IsCDRom;πbeginπ Regs.AX := $1500;π Regs.BX := $0000;π Regs.CX := $0000;π Intr( $2F, Regs);π writeln('CD Available : ', (Regs.BX > 0));πend;πππbeginπ IsCDRom;πend.π 52 11-02-9305:34ALL ERIC GIVLER Getting Drive INFO IMPORT 10 ╣Dº {πERIC GIVLERππ> about, evidentally), are two different things. The serialπ> number is only accessible in Dos v4.0+, and (I think), youπ> have to use the FCBs to get it.ππNo, no FCBs, see:π}ππUsesπ Dos,π Crt;ππTypeπ MIDRecord = Recordπ InfoLevel : Word;π SerialNum : LongInt; {This is the serial number...}π VolLabel : Array [1..11] of Char;π FatType : Array [1..8] of Char;π end;ππFunction Label_Fat(Var Mid : MidRecord; Drive : Word) : Boolean;πVarπ Result : Word;π Regs : Registers;πbeginπ FillChar(Mid,SizeOf(Mid),0);π FillChar(Regs,SizeOf(Regs),0);π With Regs DOπ beginπ AX := $440D;π BX := Drive;π CX := $0866;π DS := Seg(Mid);π DX := Ofs(Mid);π Intr($21,Regs);π Case AX ofπ $01 : Label_Fat := False;π $02 : Label_Fat := False;π $05 : Label_Fat := False;π elseπ Label_Fat := True;π end;π end;πend;ππVarπ Mid : MidRecord;πbeginπ ClrScr;π if Label_Fat(Mid,0) Thenπ With Mid DOπ beginπ Writeln(SerialNum);π Writeln(VolLabel);π Writeln(FatType);π endπ elseπ Writeln('Error Occured');πend.ππ 53 11-02-9306:11ALL DESCLIN JEAN Detecting RAM Disks IMPORT 34 ╣■| {πDesclin Jean <desclinj@ulb.ac.be>ππ a few days ago (sorry, I didn't write down the name of the personπ who posted the question :-(), someone asked how one couldπ identify a drive as a ramdisk.π Below is a solution, which I submit with the hope that someoneπ else could show how to improve on it, since it is not 'fail-safe'.π Here it comes...ππModified after Michael Tischer: Turbo Pascal 6 System ProgrammingπABACUS Publisher Grand Rapids, MI 49512 1991 ISBN 1-55755-124-3πI had to write the procedure Getdrives twice in order to take intoπaccount the changes in the DPB structure which occurred from DOSπ4.0 onwards. Mostly, Ramdisks have only one File Allocation Table,πwhereas other drive types have two. That's what a procedure suchπas GetDiskClass of TurboPower Object Professional (usual disclaimerπhere ;-)) uses to decide whether the drive is a ramdisk or not. BUTπBEWARE! This is not necessarily so! Norton mentions, in his 'diskπcompanion', that depending on the device driver of the ramdisk, oneπor two FATS may be implemented. I could verify this on 'STACKED'πramdisks: they have two FATS, whereas only one FAT is present afterπ'unSTACKING' :-(. Thus, the solution below is somewhat shaky.π}πππprogram idramdsk;πusesπ Dos;ππvarπ ver : byte;ππprocedure GetDrives1;πtypeπ DPBPTR = ^DPB; { pointer to a DOS Parameter Block }π DPBPTRPTR = ^DPBPTR; { pointer to a pointer to a DPB }π DPB = record { recreation of a DOS Parameter Block }π Code : byte; { drive code (0=A, 1=B etc. }π dummy1 : array [1..$07] of byte;{irrelevant bytes}π FatNb : byte; {Number of File Allocation Tables }π dummy2 : array [9..$17] of byte;{irrelevant bytes}π Next : DPBPTR; { pointer to next DPB }π end; { xxxx:FFFF marks last DPB }ππvarπ Regs : Registers; { register for interrupt call }π CurrDpbP : DPBPTR; { pointer to DPBs in memory }ππbeginπ {-- get pointer to first DPB ------------------------------------}π Regs.AH := $52; {function $52 returns ptr to DOS Information Block }π MsDos(Regs); {that's an UNDOCUMENTED DOS function ! }π CurrDpbP := DPBPTRPTR(ptr(Regs.ES, Regs.BX))^;ππ {-- follow the chain of DPBs--------------------------------------}π repeatπ writeln(chr(ord('A') + CurrDpbP^.Code), {display device code }π ':(FATS: ', CurrDpbP^.FatNb,')'); {and number of FATs }ππ CurrDpbP := CurrDpbP^.Next; { set pointer to next DPB }π until (Ofs(CurrDpbP^) = $FFFF); { until last DPB is reached }πend;ππprocedure GetDrives2;πtypeπ DPBPTR = ^DPB; { pointer to a DOS Parameter Block }π DPBPTRPTR = ^DPBPTR; { pointer to a pointer to a DPB }π DPB = record { recreation of a DOS Parameter Block }π Code : byte; { drive code (0=A, 1=B etc. }π dummy1 : array [1..$07] of byte;{irrelevant bytes}π FatNb : byte; { Number of File Allocation Tables}π dummy2 : array [9..$18] of byte;{irrelevant bytes}π Next : DPBPTR; { pointer to next DPB }π end; { xxxx:FFFF marks last DPB }ππvarπ Regs : Registers; { register for interrupt call }π CurrDpbP : DPBPTR; { pointer to DPBs in memory }ππbeginπ {-- get pointer to first DPB-------------------------------------}π Regs.AH := $52; {function $52 returns ptr to Dos Information Block }π MsDos(Regs); {that's an UNDOCUMENTED DOS function ! }π CurrDpbP := DPBPTRPTR(ptr(Regs.ES, Regs.BX))^;ππ {-- follow the chain of DPBs -------------------------------------}π repeatπ {output device letter and number of FATs (1 for RAM disks) }π writeln(chr(ord('A') + CurrDpbP^.Code), ':(FATS: ', CurrDpbP^.FatNb, ')');π CurrDpbP := CurrDpbP^.Next; { set pointer to next DPB }π until (Ofs(CurrDpbP^) = $FFFF); { until last DPB is reached }πend;ππbeginπ ver := Lo(DosVersion);π writeln(#13#10'Installed drives: '#13#10);π if ver < 4 thenπ GetDrives1π elseπ GetDrives2πend.ππ 54 11-02-9306:17ALL JIMISOLA LAURSEN Disk Serial Number in ASMIMPORT 14 ╣ ╜ {πjimisola.laursen@cindy.ct.se (jimisola laursen)ππ> Anybody know how to read the Volume Serial Number from a (hard) disk??π> No problem getting the Volume Label, but this seemsa to be another matter...π}ππUnit Serial;ππInterfaceππUsesπ Dos;ππFunction Get_Serial_number(Drive : Byte) : String;ππImplementationππAsmπ mov ax, wπ mov bx, bπ xor cx, cxπ les di, @resultπ xor si, siπ jcxz @@@20π @@@10:π xor dx, dxπ div bxπ cmp dl, 10π jb @h10π add dl, 'A'-10π jmp @h20π @h10:π or dl, '0'π @h20:π push dxπ inc siπ loop @@@10π @@@20:π inc cxπ or ax, axπ jnz @@@10π mov cx, siπ jcxz @@@40π cldπ mov al, clπ stosbπ @@@30:π pop axπ stosbπ loop @@@30π @@@40:πend;ππFunction Get_Serial_number(Drive : Byte) : String;π(* "Drive" is 0=current, 1=A:, 2=B: osv.. *)πTypeπ Disk_info = Recordπ RES : Word; (* reserverad ska Vara 0 *)π SER_NR1 : Word; (* Serinummer (bin{rt) *)π SER_NR2 : Word; (* Serinummer (bin{rt) *)π VOL : Array [1..11] of Char;(* Volume Label *)π TYP : Array [1..8] of Char; (* tex 'FAT12' eller 'FAT16' *)π end;πVarπ D_I : Disk_Info;π s1, s2 : String[5];πbeginπ Asmπ push dsπ mov ax,ssπ mov ds,axπ lea dx,D_Iπ mov bl,driveπ mov ax,6900hπ int 21hπ pop dsπ end;π s1 := NumAscii(D_I.SER_NR2, 16);π s2 := NumAscii(D_I.SER_NR1, 16);π While length(s1) < 4 doπ s1 := '0' + s1;π While length(s2) < 4 doπ s2 := '0' + s2;π Get_Serial_number := s1 + '-' + s2;πend;ππend.π 55 11-21-9309:25ALL HENNING JORGENSEN FORMAT FLOPPY IMPORT 244 ╣9µ {$R-,S-,I-,B-,F-,O+}ππ{---------------------------------------------------------π BIOS disk I/O routines for floppy drives. Supports DOSπ real mode, DOS protected mode, and Windows. Requiresπ TP6, TPW, or BP7.ππ All functions are for floppy disks only; no hard drives.ππ See the individual types and functions in the interface ofπ this unit for more information. See the FMT.PAS sampleπ program for an example of formatting disks.ππ For status code definitions, see the implementation ofπ function GetStatusStr.ππ ---------------------------------------------------------π Based on a unit provided by Henning Jorgensen of Denmark.π Modified and cleaned up by TurboPower Software for pmodeπ and Windows operation.ππ TurboPower Softwareπ P.O. Box 49009π Colorado Springs, CO 80949-9009ππ CompuServe: 76004,2611ππ Version 1.0 10/25/93π Version 1.1 10/29/93π fix a dumb bug in the MediaArray checkπ ---------------------------------------------------------}ππunit BDisk;π {-BIOS disk I/O routines for floppy drives}ππinterfaceππconstπ MaxRetries : Byte = 3; {Number of automatic retries forπ read, write, verify, format}ππtypeπ DriveNumber = 0..7; {Acceptable floppy drive numbers}π {Generally, 0 = A, 1 = B}ππ DriveType = 0..4; {Floppy drive or disk types}π {0 = unknown or errorπ 1 = 360Kπ 2 = 1.2Mπ 3 = 720Kπ 4 = 1.44M}ππ VolumeStr = String[11]; {String for volume labels}ππ FormatAbortFunc = {Prototype for format abort func}π function (Track : Byte; {Track number being formatted, 0..MaxTrack}π MaxTrack : Byte; {Maximum track number for this format}π Kind : Byte {0 = format beginning}π {1 = formatting Track}π {2 = verifying Track}π {3 = writing boot and FAT}π {4 = format ending, Track = format status}π ) : Boolean; {Return True to abort format}πππprocedure ResetDrive(Drive : DriveNumber);π {-Reset drive system (function $00). Call after any otherπ disk function fails}πππfunction GetDiskStatus : Byte;π {-Get status of last int $13 operation (function $01)}πππfunction GetStatusStr(ErrNum : Byte) : String;π {-Return message string for any of the status codes used byπ this unit.}πππfunction GetDriveType(Drive : DriveNumber) : DriveType;π {-Get drive type (function $08). Note that this returns theπ type of the *drive*, not the type of the diskette in it.π GetDriveType returns 0 for an invalid drive.}πππfunction AllocBuffer(var P : Pointer; Size : Word) : Boolean;π {-Allocate a buffer useable in real and protected mode.π Buffers passed to ReadSectors and WriteSectors in pmodeπ *MUST* be allocated by using this function. AllocBuffer returnsπ False if sufficient memory is not available. P is also set toπ nil in that case.}πππprocedure FreeBuffer(P : Pointer; Size : Word);π {-Free buffer allocated by AllocBuffer. Size must match theπ size originally passed to AllocBuffer. FreeBuffer doesπ nothing if P is nil.}πππfunction ReadSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π {-Read absolute disk sectors (function $02). Track, Side,π and SSect specify the location of the first sector toπ read. NSect is the number of sectors to read. Bufferπ must be large enough to hold these sectors. ReadSectorsπ returns a status code, 0 for success.}πππfunction WriteSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π {-Write absolute disk sectors (function $03). Track, Side,π and SSect specify the location of the first sector toπ write. NSect is the number of sectors to write. Bufferπ must contain all the data to write. WriteSectorsπ returns a status code, 0 for success.}πππfunction VerifySectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte) : Byte;π {-Verify absolute disk sectors (function $04). Thisπ tests a computed CRC with the CRC stored along with theπ sector. Track, Side, and SSect specify the location ofπ the first sector to verify. NSect is the number ofπ sectors to verify. VerifySectors returns a status code,π 0 for success. Don't call VerifySectors on PC/XTs andπ PC/ATs with a BIOS from 1985. It will overwrite theπ stack.}πππfunction FormatDisk(Drive : DriveNumber; DType : DriveType;π Verify : Boolean; MaxBadSects : Byte;π VLabel : VolumeStr;π FAF : FormatAbortFunc) : Byte;π {-Format drive that contains a disk of type DType. If Verifyπ is True, each track is verified after it is formatted.π MaxBadSects specifies the number of sectors that can beπ bad before the format is halted. If VLabel is not anπ empty string, FormatDisk puts the BIOS-level volumeπ label onto the diskette. It does *not* add a DOS-levelπ volume label. FAF is a user function hook that can beπ used to display status during the format, and to abortπ the format if the user so chooses. Parameters passed toπ this function are described in FormatAbortFunc above.π FormatDisk also writes a boot sector and empty Fileπ Allocation Tables for the disk. FormatDisk returns aπ status code, 0 for success.}πππfunction EmptyAbortFunc(Track : Byte; MaxTrack : Byte; Kind : Byte) : Boolean;π {-Do-nothing abort function for FormatDisk}ππ {========================================================================}ππimplementationππusesπ{$IFDEF DPMI}π WinApi,π Dos;π {$DEFINE pmode}π{$ELSE}π{$IFDEF Windows}π WinApi,π WinDos;π {$DEFINE pmode}π{$ELSE}π Dos;π {$UNDEF pmode}π{$ENDIF}π{$ENDIF}ππ{$IFDEF Windows}πtypeπ Registers = TRegisters;π DateTime = TDateTime;π{$ENDIF}ππtypeπ DiskRec =π recordπ SSZ : Byte; {Sector size}π SPT : Byte; {Sectors/track}π TPD : Byte; {Tracks/disk}π SPF : Byte; {Sectors/FAT}π DSC : Byte; {Directory sectors}π FID : Byte; {Format id for FAT}π BRD : array[0..13] of Byte; {Variable boot record data}π end;π DiskRecs = array[1..4] of DiskRec;π SectorArray = array[0..511] of Byte;ππconstπ DData : DiskRecs = {BRD starts at offset 13 of FAT}π ((SSZ : $02; SPT : $09; TPD : $27; SPF : $02; DSC : $07; FID : $FD; {5.25" - 360K}π BRD : ($02, $01, $00, $02, $70, $00, $D0, $02, $FD, $02, $00, $09, $00, $02)),π (SSZ : $02; SPT : $0F; TPD : $4F; SPF : $07; DSC : $0E; FID : $F9; {5.25" - 1.2M}π BRD : ($01, $01, $00, $02, $E0, $00, $60, $09, $F9, $07, $00, $0F, $00, $02)),π (SSZ : $02; SPT : $09; TPD : $4F; SPF : $03; DSC : $07; FID : $F9; {3.50" - 720K}π BRD : ($02, $01, $00, $02, $70, $00, $A0, $05, $F9, $03, $00, $09, $00, $02)),π (SSZ : $02; SPT : $12; TPD : $4F; SPF : $09; DSC : $0E; FID : $F0; {3.50" - 1.44M}π BRD : ($01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00, $12, $00, $02)));ππ BootRecord : SectorArray = {Standard boot program}π ($EB, $34, $90, $41, $4D, $53, $54, $20, $33, $2E, $30, $00, $02, $01, $01, $00, $02, $E0, $00, $40, $0B, $F0, $09, $00,π $12, $00, $02, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $12,π $00, $00, $00, $00, $01, $00, $FA, $33, $C0, $8E, $D0, $BC, $00, $7C, $16, $07, $BB, $78, $00, $36, $C5, $37, $1E, $56,π $16, $53, $BF, $2B, $7C, $B9, $0B, $00, $FC, $AC, $26, $80, $3D, $00, $74, $03, $26, $8A, $05, $AA, $8A, $C4, $E2, $F1,π $06, $1F, $89, $47, $02, $C7, $07, $2B, $7C, $FB, $CD, $13, $72, $67, $A0, $10, $7C, $98, $F7, $26, $16, $7C, $03, $06,π $1C, $7C, $03, $06, $0E, $7C, $A3, $3F, $7C, $A3, $37, $7C, $B8, $20, $00, $F7, $26, $11, $7C, $8B, $1E, $0B, $7C, $03,π $C3, $48, $F7, $F3, $01, $06, $37, $7C, $BB, $00, $05, $A1, $3F, $7C, $E8, $9F, $00, $B8, $01, $02, $E8, $B3, $00, $72,π $19, $8B, $FB, $B9, $0B, $00, $BE, $D6, $7D, $F3, $A6, $75, $0D, $8D, $7F, $20, $BE, $E1, $7D, $B9, $0B, $00, $F3, $A6,π $74, $18, $BE, $77, $7D, $E8, $6A, $00, $32, $E4, $CD, $16, $5E, $1F, $8F, $04, $8F, $44, $02, $CD, $19, $BE, $C0, $7D,π $EB, $EB, $A1, $1C, $05, $33, $D2, $F7, $36, $0B, $7C, $FE, $C0, $A2, $3C, $7C, $A1, $37, $7C, $A3, $3D, $7C, $BB, $00,π $07, $A1, $37, $7C, $E8, $49, $00, $A1, $18, $7C, $2A, $06, $3B, $7C, $40, $38, $06, $3C, $7C, $73, $03, $A0, $3C, $7C,π $50, $E8, $4E, $00, $58, $72, $C6, $28, $06, $3C, $7C, $74, $0C, $01, $06, $37, $7C, $F7, $26, $0B, $7C, $03, $D8, $EB,π $D0, $8A, $2E, $15, $7C, $8A, $16, $FD, $7D, $8B, $1E, $3D, $7C, $EA, $00, $00, $70, $00, $AC, $0A, $C0, $74, $22, $B4,π $0E, $BB, $07, $00, $CD, $10, $EB, $F2, $33, $D2, $F7, $36, $18, $7C, $FE, $C2, $88, $16, $3B, $7C, $33, $D2, $F7, $36,π $1A, $7C, $88, $16, $2A, $7C, $A3, $39, $7C, $C3, $B4, $02, $8B, $16, $39, $7C, $B1, $06, $D2, $E6, $0A, $36, $3B, $7C,π $8B, $CA, $86, $E9, $8A, $16, $FD, $7D, $8A, $36, $2A, $7C, $CD, $13, $C3, $0D, $0A, $4E, $6F, $6E, $2D, $53, $79, $73,π $74, $65, $6D, $20, $64, $69, $73, $6B, $20, $6F, $72, $20, $64, $69, $73, $6B, $20, $65, $72, $72, $6F, $72, $0D, $0A,π $52, $65, $70, $6C, $61, $63, $65, $20, $61, $6E, $64, $20, $73, $74, $72, $69, $6B, $65, $20, $61, $6E, $79, $20, $6B,π $65, $79, $20, $77, $68, $65, $6E, $20, $72, $65, $61, $64, $79, $0D, $0A, $00, $0D, $0A, $44, $69, $73, $6B, $20, $42,π $6F, $6F, $74, $20, $66, $61, $69, $6C, $75, $72, $65, $0D, $0A, $00, $49, $4F, $20, $20, $20, $20, $20, $20, $53, $59,π $53, $4D, $53, $44, $4F, $53, $20, $20, $20, $53, $59, $53, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,π $00, $00, $00, $00, $00, $00, $55, $AA);ππ MediaArray : array[DriveType, 1..2] of Byte =π (($00, $00), {Unknown disk}π ($01, $02), {360K disk}π ($00, $03), {1.2M disk}π ($00, $04), {720K disk}π ($00, $04)); {1.44M disk}ππ{$IFDEF pmode}πtypeπ DPMIRegisters =π recordπ DI : LongInt;π SI : LongInt;π BP : LongInt;π Reserved : LongInt;π BX : LongInt;π DX : LongInt;π CX : LongInt;π AX : LongInt;π Flags : Word;π ES : Word;π DS : Word;π FS : Word;π GS : Word;π IP : Word;π CS : Word;π SP : Word;π SS : Word;π end;ππ function GetRealSelector(RealPtr : Pointer; Limit : Word) : Word;π {-Set up a selector to point to RealPtr memory}π typeπ OS =π recordπ O, S : Word;π end;π varπ Status : Word;π Selector : Word;π Base : LongInt;π beginπ GetRealSelector := 0;π Selector := AllocSelector(0);π if Selector = 0 thenπ Exit;π {Assure a read/write selector}π Status := ChangeSelector(CSeg, Selector);π Base := (LongInt(OS(RealPtr).S) shl 4)+LongInt(OS(RealPtr).O);π if SetSelectorBase(Selector, Base) = 0 then beginπ Selector := FreeSelector(Selector);π Exit;π end;π Status := SetSelectorLimit(Selector, Limit);π GetRealSelector := Selector;π end;ππ procedure GetRealIntVec(IntNo : Byte; var Vector : Pointer); Assembler;π asmπ mov ax,0200hπ mov bl,IntNoπ int 31hπ les di,Vectorπ mov word ptr es:[di],dxπ mov word ptr es:[di+2],cxπ end;ππ function RealIntr(IntNo : Byte; var Regs : DPMIRegisters) : Word; Assembler;π asmπ xor bx,bxπ mov bl,IntNoπ xor cx,cx {StackWords = 0}π les di,Regsπ mov ax,0300hπ int 31hπ jc @@ExitPointπ xor ax,axπ @@ExitPoint:π end;π{$ENDIF}ππ procedure Int13Call(var Regs : Registers);π {-Call int $13 for real or protected mode}π{$IFDEF pmode}π varπ Base : LongInt;π DRegs : DPMIRegisters;π{$ENDIF}π beginπ{$IFDEF pmode}π {This pmode code is valid only for the AH values used in this unit}π FillChar(DRegs, SizeOf(DPMIRegisters), 0);π DRegs.AX := Regs.AX;π DRegs.BX := Regs.BX;π DRegs.CX := Regs.CX;π DRegs.DX := Regs.DX;π case Regs.AH ofπ 2, 3, 5 :π {Calls that use ES as a buffer segment}π beginπ Base := GetSelectorBase(Regs.ES);π if (Base <= 0) or (Base > $FFFF0) then beginπ Regs.Flags := 1;π Regs.AX := 1;π Exit;π end;π DRegs.ES := Base shr 4;π end;π end;π if RealIntr($13, DRegs) <> 0 then beginπ Regs.Flags := 1;π Regs.AX := 1;π end else beginπ Regs.Flags := DRegs.Flags;π Regs.AX := DRegs.AX;π Regs.BX := DRegs.BX; {BX is returned by GetDriveType function only}π end;ππ{$ELSE}π Intr($13, Regs);π{$ENDIF}π end;ππ function GetDriveType(Drive : DriveNumber) : DriveType;π varπ Regs : Registers;π beginπ Regs.AH := $08;π Regs.DL := Drive;π Int13Call(Regs);π if Regs.AH = 0 thenπ GetDriveType := Regs.BLπ elseπ GetDriveType := 0;π end;ππ function GetDiskStatus : Byte;π varπ Regs : Registers;π beginπ Regs.AH := $01;π Int13Call(Regs);π GetDiskStatus := Regs.AL;π end;ππ function GetStatusStr(ErrNum : Byte) : String;π varπ NumStr : string[3];π beginπ case ErrNum ofπ {Following codes are defined by the floppy BIOS}π $00 : GetStatusStr := '';π $01 : GetStatusStr := 'Invalid command';π $02 : GetStatusStr := 'Address mark not found';π $03 : GetStatusStr := 'Disk write protected';π $04 : GetStatusStr := 'Sector not found';π $06 : GetStatusStr := 'Floppy disk removed';π $08 : GetStatusStr := 'DMA overrun';π $09 : GetStatusStr := 'DMA crossed 64KB boundary';π $0C : GetStatusStr := 'Media type not found';π $10 : GetStatusStr := 'Uncorrectable CRC error';π $20 : GetStatusStr := 'Controller failed';π $40 : GetStatusStr := 'Seek failed';π $80 : GetStatusStr := 'Disk timed out';ππ {Following codes are added by this unit}π $FA : GetStatusStr := 'Format aborted';π $FB : GetStatusStr := 'Invalid media type';π $FC : GetStatusStr := 'Too many bad sectors';π $FD : GetStatusStr := 'Disk bad';π $FE : GetStatusStr := 'Invalid drive or type';π $FF : GetStatusStr := 'Insufficient memory';π elseπ Str(ErrNum, NumStr);π GetStatusStr := 'Unknown error '+NumStr;π end;π end;ππ procedure ResetDrive(Drive : DriveNumber);π varπ Regs : Registers;π beginπ Regs.AH := $00;π Regs.DL := Drive;π Int13Call(Regs);π end;ππ function AllocBuffer(var P : Pointer; Size : Word) : Boolean;π varπ L : LongInt;π beginπ{$IFDEF pmode}π L := GlobalDosAlloc(Size);π if L <> 0 then beginπ P := Ptr(Word(L and $FFFF), 0);π AllocBuffer := True;π end else beginπ P := nil;π AllocBuffer := Falseπ end;π{$ELSE}π if MaxAvail >= Size then beginπ GetMem(P, Size);π AllocBuffer := True;π end else beginπ P := nil;π AllocBuffer := False;π end;π{$ENDIF}π end;ππ procedure FreeBuffer(P : Pointer; Size : Word);π beginπ if P = nil thenπ Exit;π{$IFDEF pmode}π Size := GlobalDosFree(LongInt(P) shr 16);π{$ELSE}π FreeMem(P, Size);π{$ENDIF}π end;ππ function CheckParms(DType : DriveType; Drive : DriveNumber) : Boolean;π {-Make sure drive and type are within range}π beginπ CheckParms := False;π if (DType < 1) or (DType > 4) thenπ Exit;π if (Drive > 7) thenπ Exit;π CheckParms := True;π end;ππ function SubfSectors(SubFunc : Byte;π Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π {-Code shared by ReadSectors, WriteSectors, VerifySectors, FormatTrack}π varπ Tries : Byte;π Done : Boolean;π Regs : Registers;π beginπ Tries := 1;π Done := False;π repeatπ Regs.AH := SubFunc;π Regs.AL := NSect;π Regs.CH := Track;π Regs.CL := SSect;π Regs.DH := Side;π Regs.DL := Drive;π Regs.ES := Seg(Buffer);π Regs.BX := Ofs(Buffer);π Int13Call(Regs);ππ if Regs.AH <> 0 then beginπ ResetDrive(Drive);π Inc(Tries);π if Tries > MaxRetries thenπ Done := True;π end elseπ Done := True;π until Done;ππ SubfSectors := Regs.AH;π end;ππ function ReadSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π beginπ ReadSectors := SubfSectors($02, Drive, Track, Side, SSect, NSect, Buffer);π end;ππ function WriteSectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte;π var Buffer) : Byte;π beginπ WriteSectors := SubfSectors($03, Drive, Track, Side, SSect, NSect, Buffer);π end;ππ function VerifySectors(Drive : DriveNumber;π Track, Side, SSect, NSect : Byte) : Byte;π varπ Dummy : Byte;π beginπ VerifySectors := SubfSectors($04, Drive, Track, Side, SSect, NSect, Dummy);π end;ππ function SetDriveTable(DType : DriveType) : Boolean;π {-Set drive table parameters for formatting}π varπ P : Pointer;π DBSeg : Word;π DBOfs : Word;π beginπ SetDriveTable := False;ππ{$IFDEF pmode}π GetRealIntVec($1E, P);π DBSeg := GetRealSelector(P, $FFFF);π if DBSeg = 0 thenπ Exit;π DBOfs := 0;π{$ELSE}π GetIntVec($1E, P);π DBSeg := LongInt(P) shr 16;π DBOfs := LongInt(P) and $FFFF;π{$ENDIF}ππ {Set gap length for formatting}π case DType ofπ 1 : Mem[DBSeg:DBOfs+7] := $50; {360K}π 2 : Mem[DBSeg:DBOfs+7] := $54; {1.2M}π 3,π 4 : Mem[DBSeg:DBOfs+7] := $6C; {720K or 1.44M}π end;ππ {Set max sectors/track}π Mem[DBSeg:DBOfs+4] := DData[DType].SPT;ππ{$IFDEF pmode}π DBSeg := FreeSelector(DBSeg);π{$ENDIF}ππ SetDriveTable := True;π end;ππ function GetMachineID : Byte;π {-Return machine ID code}π{$IFDEF pmode}π varπ SegFFFF : Word;π{$ENDIF}π beginπ{$IFDEF pmode}π SegFFFF := GetRealSelector(Ptr($FFFF, $0000), $FFFF);π if SegFFFF = 0 thenπ GetMachineID := 0π else beginπ GetMachineID := Mem[SegFFFF:$000E];π SegFFFF := FreeSelector(SegFFFF);π end;π{$ELSE}π GetMachineID := Mem[$FFFF:$000E];π{$ENDIF}π end;ππ function IsATMachine : Boolean;π {-Return True if AT or better machine}π beginπ IsATMachine := False;π if Lo(DosVersion) >= 3 thenπ case GetMachineId ofπ $FC, $F8 : {AT or PS/2}π IsATMachine := True;π end;π end;ππ function GetChangeLineType(Drive : DriveNumber; var CLT : Byte) : Byte;π {-Return change line type of drive}π varπ Regs : Registers;π beginπ Regs.AH := $15;π Regs.DL := Drive;π Int13Call(Regs);π if (Regs.Flags and FCarry) <> 0 then beginπ GetChangeLineType := Regs.AH;π CLT := 0;π end else beginπ GetChangeLineType := 0;π CLT := Regs.AH;π end;π end;ππ function SetFloppyType(Drive : DriveNumber; FType : Byte) : Byte;π {-Set floppy type for formatting}π varπ Tries : Byte;π Done : Boolean;π Regs : Registers;π beginπ Tries := 1;π Done := False;π repeatπ Regs.AH := $17;π Regs.AL := FType;π Regs.DL := Drive;π Int13Call(Regs);π if Regs.AH <> 0 then beginπ ResetDrive(Drive);π Inc(Tries);π if Tries > MaxRetries thenπ Done := True;π end elseπ Done := True;π until Done;ππ SetFloppyType := Regs.AH;π end;ππ function SetMediaType(Drive : DriveType; TPD : Byte; SPT : Byte) : Byte;π {-Set media type for formatting}π varπ Regs : Registers;π beginπ Regs.AH := $18;π Regs.DL := Drive;π Regs.CH := TPD;π Regs.CL := SPT;π Int13Call(Regs);π SetMediaType := Regs.AH;π end;ππ function FormatDisk(Drive : DriveNumber; DType : DriveType;π Verify : Boolean; MaxBadSects : Byte;π VLabel : VolumeStr;π FAF : FormatAbortFunc) : Byte;π labelπ ExitPoint;π typeπ CHRNRec =π recordπ CTrack : Byte; {Track 0..?}π CSide : Byte; {Side 0..1}π CSect : Byte; {Sector 1..?}π CSize : Byte; {Size 0..?}π end;π CHRNArray = array[1..18] of CHRNRec;π FATArray = array[0..4607] of Byte;π varπ Tries : Byte;π Track : Byte;π Side : Byte;π Sector : Byte;π RWritten : Byte;π RTotal : Byte;π FatNum : Byte;π BadSects : Byte;π ChangeLine : Byte;π DiskType : Byte;π Status : Byte;π Done : Boolean;π Trash : Word;π DT : DateTime;π VDate : LongInt;π Regs : Registers;π BootPtr : ^SectorArray;π CHRN : ^CHRNArray;π FATs : ^FATArray;ππ procedure MarkBadSector(Track, Side, Sector : Byte);π constπ BadMark = $FF7; {Bad cluster mark}π varπ CNum : Integer; {Cluster number}π FOfs : Word; {Offset into fat for this cluster}π FVal : Word; {FAT value for this cluster}π OFVal : Word; {Old FAT value for this cluster}π beginπ CNum := (((((Track*2)+Side)*DData[DType].SPT)+Sector-RTotal-2) divπ DData[DType].BRD[0])+2;π if CNum > 1 then beginπ {Sector is in data space}π FOfs := (CNum*3) div 2;π Move(FATs^[FOfs], FVal, 2);π if Odd(CNum) thenπ OFVal := (FVal and (BadMark shl 4))π elseπ OFVal := (FVal and BadMark);π if OFVal = 0 then beginπ {Not already marked bad, mark it}π if Odd(CNum) thenπ FVal := (FVal or (BadMark shl 4))π elseπ FVal := (FVal or BadMark);π Move(FVal, FATs^[FOfs], 2);π {Add to bad sector count}π Inc(BadSects, DData[DType].BRD[0]);π end;π end;π end;ππ beginπ {Validate parameters. Can't do anything unless these are reasonable}π if not CheckParms(DType, Drive) thenπ Exit;ππ {Initialize buffer pointers in case of failure}π FATs := nil;π CHRN := nil;π BootPtr := nil;ππ {Status proc: starting format}π if FAF(0, DData[DType].TPD, 0) then beginπ Status := $FA;π goto ExitPoint;π end;ππ {Error code for invalid drive or media type}π Status := $FE;ππ case GetDriveType(Drive) ofπ 1 : {360K drive formats only 360K disks}π if DType <> 1 thenπ goto ExitPoint;π 2 : {1.2M drive formats 360K or 1.2M disk}π if DType > 2 thenπ goto ExitPoint;π 3 : {720K drive formats only 720K disks}π if DType <> 3 thenπ goto ExitPoint;π 4 : {1.44M drive formats 720K or 1.44M disks}π if Dtype < 3 thenπ goto ExitPoint;π elseπ goto ExitPoint;π end;ππ {Error code for out-of-memory or DPMI error}π Status := $FF;ππ {Allocate buffers}π if not AllocBuffer(Pointer(FATs), SizeOf(FATArray)) thenπ goto ExitPoint;π if not AllocBuffer(Pointer(CHRN), SizeOf(CHRNArray)) thenπ goto ExitPoint;π if not AllocBuffer(Pointer(BootPtr), SizeOf(BootRecord)) thenπ goto ExitPoint;ππ {Initialize boot record}π Move(BootRecord, BootPtr^, SizeOf(BootRecord));π Move(DData[DType].BRD, BootPtr^[13], 14);ππ {Initialize the FAT table}π FillChar(FATs^, SizeOf(FATArray), 0);π FATs^[0] := DData[DType].FID;π FATs^[1] := $FF;π FATs^[2] := $FF;ππ {Set drive table parameters by patching drive table in memory}π if not SetDriveTable(DType) thenπ goto ExitPoint;ππ {On AT class machines, set format parameters via BIOS}π if IsATMachine then beginπ {Get change line type: 1 -> 360K drive, 2 -> 1.2M or 3.5" drive}π Status := GetChangeLineType(Drive, ChangeLine);π if Status <> 0 thenπ goto ExitPoint;π if (ChangeLine < 1) or (ChangeLine > 2) then beginπ Status := 1;π goto ExitPoint;π end;ππ {Determine floppy type for SetFloppyType call}π DiskType := MediaArray[DType, ChangeLine];π if DiskType = 0 then beginπ Status := $FB;π goto ExitPoint;π end;ππ {Set floppy type for drive}π Status := SetFloppyType(Drive, DiskType);π if Status <> 0 thenπ goto ExitPoint;ππ {Set media type for format}π Status := SetMediaType(Drive, DData[DType].TPD, DData[DType].SPT);π if Status <> 0 thenπ goto ExitPoint;π end;ππ {Format each sector}π ResetDrive(Drive);π BadSects := 0;ππ for Track := 0 to DData[DType].TPD do beginπ {Status proc: formatting track}π if FAF(Track, DData[DType].TPD, 1) then beginπ Status := $FA;π goto ExitPoint;π end;ππ for Side := 0 to 1 do beginπ {Initialize CHRN for this sector}π for Sector := 1 to DData[DType].SPT doπ with CHRN^[Sector] do beginπ CTrack := Track;π CSide := Side;π CSect := Sector;π CSize := DData[DType].SSZ;π end;ππ {Format this sector, with retries}π Status := SubfSectors($05, Drive, Track, Side,π 1, DData[DType].SPT, CHRN^);π if Status <> 0 thenπ goto ExitPoint;π end;ππ if Verify then beginπ {Status proc: verifying track}π if FAF(Track, DData[DType].TPD, 2) then beginπ Status := $FA;π goto ExitPoint;π end;ππ for Side := 0 to 1 doπ {Verify the entire track}π if VerifySectors(Drive, Track, Side,π 1, DData[DType].SPT) <> 0 then beginπ if Track = 0 then beginπ {Disk bad}π Status := $FD;π goto ExitPoint;π end;ππ for Sector := 1 to DData[DType].SPT doπ if VerifySectors(Drive, Track, Side,π Sector, 1) <> 0 then beginπ MarkBadSector(Track, Side, Sector);π if BadSects > MaxBadSects then beginπ Status := $FC;π goto ExitPoint;π end;π end;π end;π end;π end;ππ {Status proc: writing boot and FAT}π if FAF(0, DData[DType].TPD, 3) then beginπ Status := $FA;π goto ExitPoint;π end;ππ {Write boot record}π Status := WriteSectors(Drive, 0, 0, 1, 1, BootPtr^);π if Status <> 0 then beginπ Status := $FD;π goto ExitPoint;π end;ππ {Write FATs and volume label}π Track := 0;π Side := 0;π Sector := 2;π FatNum := 0;π RTotal := (2*DData[DType].SPF)+DData[DType].DSC;π for RWritten := 0 to RTotal-1 do beginπ if Sector > DData[DType].SPT then beginπ Sector := 1;π Inc(Side);π end;ππ if RWritten < (2*DData[DType].SPF) then beginπ if FatNum > DData[DType].SPF-1 thenπ FatNum := 0;π end else beginπ FillChar(FATs^, 512, 0);π if ((VLabel <> '') and (RWritten = 2*DData[DType].SPF)) then beginπ {Put in volume label}π for Trash := 1 to Length(VLabel) doπ VLabel[Trash] := Upcase(VLabel[Trash]);π while Length(VLabel) < 11 doπ VLabel := VLabel+' ';π Move(VLabel[1], FATs^, 11);π FATs^[11] := 8;π GetDate(DT.Year, DT.Month, DT.Day, Trash);π GetTime(DT.Hour, DT.Min, DT.Sec, Trash);π PackTime(DT, VDate);π Move(VDate, FATs^[22], 4);π end;π FatNum := 0;π end;ππ if WriteSectors(Drive, Track, Side,π Sector, 1, FATs^[FatNum*512]) <> 0 then beginπ Status := $FD;π goto ExitPoint;π end;ππ Inc(Sector);π Inc(FatNum);π end;ππ {Success}π Status := 0;ππExitPoint:π FreeBuffer(BootPtr, SizeOf(BootRecord));π FreeBuffer(CHRN, SizeOf(CHRNArray));π FreeBuffer(FATs, SizeOf(FATArray));ππ {Status proc: ending format}π Done := FAF(Status, DData[DType].TPD, 4);π FormatDisk := Status;π end;ππ function EmptyAbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean;π beginπ EmptyAbortFunc := False;π end;ππend.ππ{ ------------------------------- DEMO PROGRAM -------------------- }π{ ------------------------------- CUT HERE ---------------------}ππ{$R-,S-,I-}ππprogram Fmt;π {-Simple formatting program to demonstate DISKB unit}ππusesπ{$IFDEF Windows}π WinCrt,π{$ENDIF}π BDisk;ππconstπ ESC = #27;π CR = #13;ππtypeπ CharSet = set of Char;ππvarπ DLet : Char;π DTyp : Char;π Verf : Char;π GLet : Char;π DNum : Byte;π Status : Byte;π VStr : VolumeStr;ππconstπ DriveTypeName : array[DriveType] of string[5] =π ('other', '360K', '1.2M', '720K', '1.44M');ππ{$IFNDEF Windows}π function ReadKey : Char; assembler;π {-Low budget readkey routine}π asmπ xor ah,ahπ int 16hπ end;π{$ENDIF}ππ function GetKey(Prompt : String; OKSet : CharSet) : Char;π {-Get and return a key in the OKSet}π varπ Ch : Char;π beginπ Write(Prompt);π repeatπ Ch := Upcase(ReadKey);π if Ch = ESC then beginπ WriteLn;π Halt;π end;π until (Ch in OKSet);π if Ch <> CR thenπ Write(Ch);π WriteLn;π GetKey := Ch;π end;ππ function AbortFunc(Track, MaxTrack : Byte; Kind : Byte) : Boolean; far;π {-Display formatting status. Could check for abort here too}π beginπ case Kind ofπ 0 : {Format beginning}π Write('Formatting ');π 1 : {Formatting track}π Write(^H^H^H^H, ((Track*100) div MaxTrack):3, '%');π 2 : {Verifying track}π Write(^H, 'V');π 3 : {Writing boot and FAT}π Write(^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H, 'Writing boot and FAT');π 4 : {Format ending}π beginπ Write(^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H^H);π {Track returns final status code in this case}π if Track = 0 thenπ WriteLn('Formatted successfully')π elseπ WriteLn('Format failed: ', GetStatusStr(Track));π end;π end;π AbortFunc := False;π end;ππbeginπ WriteLn('Floppy Formatter: <Esc> to exit');ππ {Get formatting parameters}π DLet := GetKey('Drive to format? (A or B): ', ['A'..'B']);π DTyp := GetKey('Disk type? (1=360K, 2=1.2M, 3=720K, 4=1.44M): ', ['1'..'4']);π Verf := GetKey('Verify? (Y or N) ', ['N', 'Y']);π Write('Volume label? ');π ReadLn(VStr);π GLet := GetKey('Insert disk and press <Enter> ', [#13]);ππ {Compute drive number}π DNum := Byte(DLet)-Byte('A');ππ WriteLn('Drive type is ', DriveTypeName[GetDriveType(DNum)]);ππ Status := FormatDisk(DNum, {drive number}π Byte(DTyp)-Byte('0'), {format type}π (Verf = 'Y'), {verify?}π 10, {max bad sectors}π VStr, {volume label}π AbortFunc); {abort function}π {AbortFunc reports the status}πend.π 56 11-21-9309:50ALL SWAG SUPPORT TEAM VOL Label Functions IMPORT 24 ╣w╟ UNIT VolFuncs;π(**) INTERFACE (**)πUSES Dos;πTYPEπ VolString = String[12];ππ FUNCTION GetLabel(driveNum : Byte;π VAR V : VolString) : Boolean;π FUNCTION SetLabel(driveNum : Byte;π NuLabel : VolString) : Boolean;π FUNCTION DelLabel(driveNum : Byte) : Boolean;ππ(**) IMPLEMENTATION (**)πTYPEπ ExFCB = RECORDπ FF : Byte; {must be 0FFh}π Reserved0 : ARRAY[1..5] OF Byte; {must be 0s}π Attribute : Byte;π DriveID : Byte;π Filename : ARRAY[1..8] OF Char;π Extension : ARRAY[1..3] OF Char;π CurBlock : Word;π RecSize : Word;π FileSize : LongInt;π Date : Word;π Time : Word;π Reserved : ARRAY[1..8] OF Byte;π CurRec : Byte;π Relative : LongInt;π END;ππ FUNCTION GetLabel(driveNum : Byte;π VAR V : VolString) : Boolean;π CONSTπ Any : String[5] = ':\*.*';π VARπ SR : SearchRec;π Mask : PathStr;π P : Byte;π BEGINπ IF DriveNum > 0 THENπ Mask[1] := Char(DriveNum + ord('@'))π ELSE GetDir(0, Mask);π Move(Any[1], Mask[2], 5);π Mask[0] := #6;π FindFirst(Mask, VolumeID, SR);π WHILE (SR.Attr AND VolumeID = 0) ANDπ (DosError = 0) DOπ FindNext(SR);π IF DosError = 0 THENπ BEGINπ FillChar(V[1], 11, ' ');π V[0] := #11;π P := Pos('.', SR.Name);π IF P = 0 THENπ Move(SR.Name[1], V[1], length(SR.Name))π ELSEπ BEGINπ Move(SR.Name[1], V[1], pred(P));π Move(SR.Name[P+1], V[9], length(SR.Name)-P);π END;π GetLabel := TRUE;π ENDπ ELSE GetLabel := FALSE;π END;ππ FUNCTION SetLabel(driveNum : Byte;π NuLabel : VolString) : Boolean;π VAR E : ExFCB;π BEGINπ WITH E DOπ BEGINπ FF := $FF;π FillChar(Reserved0, 5, 0);π Attribute := VolumeID;π DriveID := DriveNum;π FillChar(FileName, 8, ' ');π FillChar(Extension, 3, ' ');π Move(NuLabel[1], Filename, length(NuLabel));π END;π ASMπ PUSH DSπ MOV AX, SSπ MOV DS, AXπ LEA DX, E {point DS:DX at Extended FCB}π MOV AH, 16h {create using FCB}π INT 21hπ INC ALπ MOV @result, ALπ POP DSπ END;π END;ππ FUNCTION DelLabel(driveNum : Byte) : Boolean;π VAR E : ExFCB;π BEGINπ WITH E DOπ BEGINπ FF := $FF;π FillChar(Reserved0, 5, 0);π Attribute := VolumeID;π DriveID := DriveNum;π FillChar(FileName, 8, '?');π FillChar(Extension, 3, '?');π END;π ASMπ PUSH DSπ MOV AX, SSπ MOV DS, AXπ LEA DX, E {point DS:DX at Extended FCB}π MOV AH, 13h {delete using FCB}π INT 21hπ INC ALπ MOV @Result, ALπ POP DSπ END;π END;πEND. 57 11-26-9317:01ALL PHIL NICKELL Disk Ready Function IMPORT 10 ╣X {πFrom: PHIL NICKELLπSubj: Disk Ready Functionππ Here are a couple of ways that are about equivalent. Which you useπ depends on the info you might want about the drive. These callsπ actually spin up the disk and get info from the boot sector or the fatπ table, so they also incidentally check if the disk is ready and ok.π Unfortunately, DOS doesn't really have a reasonable way to tell you ifπ the disk is ready without it actually spinning up the drive.π}π var r:registers;ππ Get Allocation Table Infoπ ...on entryπ r.ah := $1ch;π r.dl := drivenum; { 0=default, 1=A, 2=B etc}π msdos(r);π ...on returnπ r.al = sectors per clusterπ r.cx = bytes per physical sectorπ r.dx = clusters per diskπ ds:bx = pointer to media descriptor byteππ Get Free Disk Space Infoπ ...on entryπ r.ah := $36;π r.dl := drivenum; { 0=default, 1=A, 2=B etc}π msdos(r);π ...on returnπ r.ax = sectors per cluster /or/π = $ffff if error.π r.bx = number of available clustersπ r.cx = bytes per sectorπ dx = clusters on the driveππ 58 01-27-9411:58ALL MIKE COPELAND Disk Labels/Volumes IMPORT 51 ╣▒ {π> Can someone please post some code on how to read a diskπ> label/serial number from a disk. I plan to use it as a copyπ> protection method (read the label/serial number on installationπ> and only the program to install on a drive the sameπ> label/serial number) Thanks!π}ππconst BSize = 4096; { I/O Buffer Size }π HexDigits: array[0..15] of char = '0123456789ABCDEF';πtype InfoBuffer = recordπ InfoLevel : word; {should be zero}π Serial : Longint;π VolLabel : array[0..10] of Char;π FileSystem : array[0..7] of Charπ end;π SerString = String[9];π DTA_Type = recordπ Flag : byte;π Res1 : array [1..5] of byte;π Mask : Byte;π Drive : Byte;π Name : array [1..8] of Char;π Ext : array [1..3] of char;π Attrx : byte;π Filler : array [12..21] of byte;π Time,π Date,π Cluster,π Size1,π Size2 : integer;π end;π FCB_Type = recordπ Flag : byte;π Res1 : array [1..5] of byte;π Mask : Byte;π Drive : Byte;π Name : array [1..8] of Char;π Ext : array [1..3] of char;π Current_Block,π Record_Size,π Size1,π Size2,π Date : integer;π Filler : array [22..31] of byte;π Record_No : byte;π File_No_1,π File_No_2 : integerπ end;π DiskIDType = String[11];π STR12 = string[12];π STR8 = string[8];π STR4 = string[4];π MEDBUF = array[1..4096] of char;πvar Drive_Mask : byte;π CH, CH1 : char;π DEVICE : char; { Disk Device }π BIN,BOUT,π BWORK : ^MEDBUF;π F : File;π SNAME : String;π DATE : string[8]; { formatted date as YY/MM/DD }π TIME : string[5]; { " time as HH:MM }π DISKNAME : string[15];π GARB : string[6]; { extraneous device id }π DirInfo : SearchRec; { File name search type }π SR : SearchRec;π DT : DateTime;π PATH : PathStr;π DIR : DirStr;π FNAME : NameStr;π EXT : ExtStr;π FCB : FCB_Type;π DTA : DTA_Type;π Regs : Registers;π Temp : String[1];π DiskID : DiskIDType;π NewDiskID : DiskIDType;π BUFF : array[1..BSize] of Byte;π IB : InfoBuffer;π S : string[11];ππfunction SerialStr(L : longint) : SerString;πvar Temp : SerString;πbeginπ Temp[0] := #9;π Temp[1] := HexDigits[L shr 28];π Temp[2] := HexDigits[(L shr 24) and $F];π Temp[3] := HexDigits[(L shr 20) and $F];π Temp[4] := HexDigits[(L shr 16) and $F];π Temp[5] := '-';π Temp[6] := HexDigits[(L shr 12) and $F];π Temp[7] := HexDigits[(L shr 8) and $F];π Temp[8] := HexDigits[(L shr 4) and $F];π Temp[9] := HexDigits[L and $F];π SerialStr :=Temp;πend;ππprocedure INITS; { basic FCB, DTA initialization }πbeginπ Drive_Mask := Ord(DEVICE) - 64;π with Regs doπ beginπ AH := $1A; DS := Seg(DTA); DX := Ofs(DTA); MSDOS (Regs);π end;π with FCB doπ beginπ Flag := $FF; Mask := $08;π for I := 1 to 5 doπ Res1[I] := 0;π Drive := Drive_Mask; Name := '????????'; Ext := '???';π end;πend; { INITS }ππfunction GetSerial(DiskNum : byte; var I : InfoBuffer) : word;πassembler;π asmπ MOV AH, 69hπ MOV AL, 00hπ MOV BL, DiskNumπ PUSH DSπ LDS DX, Iπ INT 21hπ POP DSπ JC @Badπ XOR AX, AXπ @Bad:πend;ππfunction SetSerial(DiskNum : byte; var I : InfoBuffer) : word;πAssembler;π asmπ MOV AH, 69hπ MOV AL, 00hπ MOV BL, DiskNumπ PUSH DSπ LDS DX, Iπ INT 21hπ POP DSπ JC @Badπ XOR AX, AXπ @Bad:πend;ππfunction GetDiskID (Drive : char): DiskIDType;πvar DirDiskID : STR12;π PosPeriod : Byte;πbeginπ FindFirst (DEVICE+':\*.*',VolumeID,DirInfo);π if DosError = 0 thenπ beginπ DirDiskID := DirInfo.Name; PosPeriod := Pos('.',DirDiskID);π if PosPeriod > 0 then System.Delete(DirDiskID,PosPeriod,1);π GetDiskID := DirDiskID;π GetSerial (Drive_Mask,IB); { Get Disk Serial# }π endπ else GetDiskID := '';πend; { GetDiskID }ππfunction SetDiskID (DiskID : DiskIDType): Boolean; { SET a volume label }πbeginπ with FCB doπ beginπ FillChar (Name[1],11,' '); { blank out name }π Move (DiskID[1],Name[1],Length(DiskID));π end;π with Regs doπ beginπ AH := $16; DS := Seg(FCB); DX := Ofs(FCB);π MsDos(Regs); SetDiskID := AL = 0π endπend; { SetDiskID }ππfunction DeleteDiskID : boolean; { DELETE a volume label }πbeginπ with Regs doπ beginπ AH := $13; DS := Seg(FCB); DX := Ofs(FCB);π MsDos(Regs); DeleteDiskID := AL = 0;π endπend; { DeleteDiskID }ππfunction ReNameDiskID (NewDiskID : DiskIDType): Boolean; { RENAME a volume }πbeginπ if not DeleteDiskID then writeln ('Delete Error: ',Regs.AL);π if not SetDiskID (NewDiskID) then writeln ('Rename error: ',Regs.AL);πend; { RenameDiskID }ππprocedure SetDiskInfo;πbeginπ with Regs doπ beginπ AH := $36; DL := Drive_Mask; MsDos(Regs);π ASZ := LongInt(CX * AX) * DX; FSZ := LongInt(AX * CX) * BX;π USZ := ASZ - FSZ; { amount free }π end;πend; { SetDiskInfo }ππ 59 01-27-9412:08ALL STUART KIRSCHENBAUM HD Test IMPORT 16 ╣Zé {π> function GetDriveID(drive: char):byte;π> beginπ> with regs doπ> beginπ> AH := $1C;π> DL := ord(Upcase(drive))-64;π> Intr($21,regs);π> GetDriveID := Mem[ds:bx];π> end;π> end;ππ>This interrupt (01Ch) is supposed to return 0F8h in case of a harddisk, andπ>some other value if it is a floppy. However, running OS/2, this functionπ>returns 0F0h :(( My old Apricot (it's a computer!), running DOS 3.2, alsoπ>reports 0F0h...ππ 0F0H is also the code for an unknown device for Service $1C. Iπ haven't tried it but have you looked at Service $44, function $08? Myπ sources tell me that this function (DOS 3.0 up) will return 0 in AX ifπ the device is removable, 1 if a fixed disk, and $0F if invalid drive.ππ Hang on... I'm trying it now. It seemed to work here. Below is theπ sample code I used (in TP 5.5).π}ππPROGRAM HDTest;π{Stuart Kirschenbaum 93/12/11 Donated to the Public Domain ifπ the Public actually wants it :-) }ππUSESπ DOS;ππVARπ Is_Hard_Drive : boolean;ππFUNCTION TestHD(DriveNum : byte):boolean;πVARπ Regs: Registers;πBEGINπ With Regs DO BEGINπ AH := $44;π AL := $08;π BL := DriveNum;π Intr($21, Regs);π IF AX = 0 THEN TestHD := falseπ ELSE IF AX = 0 THEN TestHD := true; {Note we really should testπ for invalid drive but thisπ is just an example <g> }π END;ππEND;ππBEGIN {Main for testing program}ππ Is_Hard_Drive := TestHD(3); {3 = Drive C a Hard Drive on my system}π IF Is_Hard_Drive THENπ writeln('Well that seemed to work fine... Let''s try a floppy')π ELSEπ writeln('That didn''t work right... Damn.');π Is_Hard_Drive := TestHD(1); {1 = Drive A, a floppy drive}π IF Is_Hard_Drive THENπ writeln('You should never see this message')π ELSEπ writeln('Success');πEND.π 60 01-27-9412:13ALL MICHAEL PHILLIPS Media ID IMPORT 31 ╣Q {π> Can someone please post some code on how to read a disk label/serialπ> number from a disk. I plan to use it as a copy protection method (readπ> the label/serial number on installation and only the program to installπ> on a drive the same label/serial number) Thanks!ππDo you realise that the serial number on a disk is changed when the disk isπformatted? Therefore if someone crashes their system and has to format theirπhard disk and restore your software from their backups your protection methodπwould be triggered! Not a very good method to use for copy protection.π}πProgram MediaID;ππUsesπ Dos;ππTypeπ Tmid = recordπ midInfoLevel : Word; { information level ? }π midSerialNum : LongInt; { serial number }π midVolLabel : packed array [1..11] of Char; { ASCII volume label }π midFileSysType : packed array [1..8] of Char; { ASCII file system }π end; { of Tmid }ππVarπ MID : Tmid;π DriveChar : Char;π DriveNum : Word;π DirInfo : SearchRec;π Volume : String;ππ Function Hex4(w : Word) : String;π constπ HexStr : packed array [$00..$0F] of Char = '0123456789ABCDEF';π varπ s : String;π ndx : Integer;π begin { of Hex4 }π s := '';π for ndx := 3 downto 0 doπ beginπ s := s + HexStr[(W shr (ndx*4)) and $0F];π end;π Hex4 := s;π end; { of Hex4 }ππ Function GetMediaID(Drive : Word) : Word;π {---------------------------------------------------------------------}π { This routine reads the VolumeLabel, SerialNumber from the boot }π { sector of the specified drive. Requires MSDOS5 or above. }π {---------------------------------------------------------------------}π begin { of GetMediaID }π asmπ mov bx, Drive { 0=default, 1=A:, 2=B: etc }π mov ch, 08h { device category (must be 08h) }π mov cl, 66h { Get Media ID }π mov dx, seg MID { ds:dx pointer to MID structure }π mov ds, dxπ mov dx, offset MIDπ mov ax, 440Dh { IOCTL for block device }π int 21hπ jc @1 { carry is set if there is an error }π mov ax, 0000h { no error - clear ax }π @1:π mov @result, ax { return error code }π end;π end; { of GetMediaID }ππ Function VolumeLabel(Drive : Char; var VolLabel : String) : Word;π {---------------------------------------------------------------------}π { This routine reads the VolumeLabel from the root directory of }π { the specified drive. }π {---------------------------------------------------------------------}π begin { of VolLabel }π FindFirst(Drive+':\*.*', VolumeID, DirInfo);π VolumeLabel := DosError;π VolLabel := DirInfo.Name;π { delete a "." which would be the 9th character }π if (Length(VolLabel) > 8) thenπ Delete(VolLabel, 8, 1);π end; { of VolLabel }ππbegin { of MediaID }ππ DriveChar := 'C';π DriveNum := ord(DriveChar) - 64;ππ if (GetMediaID(DriveNum) = 0) thenπ beginπ Writeln(output, 'InfoLevel = ', MID.midInfoLevel);π Writeln(output, 'SerialNum = ',π Hex4((MID.midSerialNum shr $10) and $FFFF), '-',π Hex4(MID.midSerialNum and $FFFF));π Writeln(output, 'VolLabel = "', MID.midVolLabel, '"');π Writeln(output, 'FileSysType = "', MID.midFileSysType, '"');π endπ elseπ beginπ { function not supported or error }π end;ππ Writeln(output);ππ if (VolumeLabel(DriveChar, Volume) = 0) thenπ Writeln(output, 'VolLabel = "', Volume, '"')π elseπ beginπ { error }π end;πend. { of MediaID }π 61 01-27-9412:19ALL DESCLIN JEAN Drive Info IMPORT 72 ╣!å {π A few days ago, Bryan Ellis (gt6918b@prism.gatech.edu) mentionedπ that he had trouble with the DiskFree function of TP.π I did'nt see any answer on this subject posted to the list.π Since I also feel that this function yields misleadingπ results to the unaware, and available clusters on the diskπ are also a requisite for full information, I post below aπ small program to document another way to implement theπ Diskfree function.ππThat part of the following code referring to the identificationπof ramdisks has already been posted on info-pascal@brl.mil; I haveπadded the procedure DiskEval to display info about the drive, becauseπI have found that many users are not aware of the notion of 'slack'πwhich is the consequence of the use of clusters.π}ππ{$N+,E+}ππprogram diskall;ππ{πdisplays all drives (except network drives :-() actually in use byπthe system, mentions when one is mapped to another one (such as B: toπA: in systems with only one floppy drive), tries to identify RAMπdisks but fails to do so with 'Stacked' disks and possibly also withπ'Doublespaced' drives: I refrained from trying the latter on _MY_πstacked HD! The program further shows the available space on the diskπchosen by the user among available drives.πFrom what I have gathered in books and on the net, there is no fail-πsafe way of identifying RAM disks. If somebody among the readers ofπthis should know otherwise, I would be grateful if he could email meπthe solution at:π desclinj@ulb.ac.be (internet; Dr Jean Desclin)π (Lab. of Histology, Fac. of Medicine)π (Brussels Free University (U.L.B.) Belgium)π}πuses Dos,CRT;ππType String25 = String[25];ππvarπ ver : byte;π DrvStr : String;π DrvLet : char;π Count : shortint;π car : char;ππProcedure Pinsert(var chain: string25);π{Eases reading long numbers by inserting decimal points(commas)}πConst pdec : string[1] = ',';πvar nv : string25;π loc : integer;πbeginπ nv := chain;π if length(chain) > 3 thenπ beginπ loc := length(chain) - 2;π Move(Nv[loc],Nv[succ(loc)],succ(Length(Nv))-loc);π Move(Pdec[1],Nv[loc],1);π inc(Nv[0]);π while (pos(pdec[1],Nv) > 4) doπ beginπ chain := Nv;π loc := pos(pdec[1],Nv) - 3;π Move(Nv[loc],Nv[succ(loc)],succ(length(Nv)) - loc);π Move(pdec[1],Nv[loc],1);π inc(Nv[0])π end;π end;π chain := nvπend;ππprocedure GetDrives1(var DS: string);{for DOS >= 3.x but <4.0 }π{Adapted from Michael Tischer's Turbo Pascal 6 System Programming, }π{Abacus 1991, ISBN 1-55755-124-3 }πtype DPBPTR = ^DPB; { pointer to a DOS Parameter Block }π DPBPTRPTR = ^DPBPTR; { pointer to a pointer to a DPB }π DPB = record { recreation of a DOS Parameter Block }π Code : byte; { drive code (0=A, 1=B etc. }π dummy1: array [1..$07] of byte;{irrelevant bytes}π FatNb : byte; {Number of File Allocation Tables }π dummy2: array [9..$17] of byte;{irrelevant bytes}π Next : DPBPTR; { pointer to next DPB }π end; { xxxx:FFFF marks last DPB }ππvar Regs : Registers; { register for interrupt call }π CurrDpbP : DPBPTR; { pointer to DPBs in memory }ππbeginπ {-- get pointer to first DPB ------------------------------------}ππ Regs.AH := $52;{ function $52 returns ptr to 'List of Lists' }π MsDos( Regs );{ that's an UNDOCUMENTED DOS function ! }π CurrDpbP := DPBPTRPTR( ptr( Regs.ES, Regs.BX ) )^;π {-- follow the chain of DPBs--------------------------------------}π repeatπ beginπ write(chr(ord('A')+CurrDpbP^.Code ),{ display device code }π ': ' );π DS := DS + chr(ord('A')+CurrDpbP^.Code);π if CurrDpbP^.Code > 0 thenπ beginπ Regs.AX := $440E;π Regs.BL := CurrDpbP^.Code;π MsDos(Regs);π if Regs.AL <> 0 thenπ writeln(' is actually mapped to ',π chr(ord('A')+pred(CurrDpbP^.Code)))π end;ππ if ((CurrDpbP^.FatNb > 0) AND (CurrDpbP^.FatNb < 2)) thenπ writeln(' (RAMDISK)');π end;π CurrDpbP := CurrDpbP^.Next; { set pointer to next DPB }π until ( Ofs( CurrDpbP^ ) = $FFFF ); { until last DPB is reached }π writelnπ end;ππprocedure GetDrives2(var DS: string);{for DOS versions>=4.0 }π{almost the same as GetDrives1, but for dummy2 which is one byte }π{longer in DOS 4+ }πtype DPBPTR = ^DPB; { pointer to a DOS Parameter Block }π DPBPTRPTR = ^DPBPTR; { pointer to a pointer to a DPB }π DPB = record { recreation of a DOS Parameter Block }π Code : byte; { drive code ( 0=A, 1=B etc. }π dummy1 : array [1..$07] of byte;{ irrelevant bytes}π FatNb : byte;{ Number of File Allocation Tables }π dummy2 : array [9..$18] of byte;{ irrelevant bytes}π Next : DPBPTR; { pointer to next DPB }π end; { xxxx:FFFF marks last DPB }ππvar Regs : Registers; { register for interrupt call }π CurrDpbP : DPBPTR; { pointer to DPBs in memory }ππbeginπ {-- get pointer to first DPB-------------------------------------}ππ Regs.AH := $52;{ function $52 returns ptr to Dos 'List of lists' }π MsDos( Regs );{ that's an UNDOCUMENTED DOS function ! }π CurrDpbP := DPBPTRPTR( ptr( Regs.ES, Regs.BX ) )^;ππ {-- follow the chain of DPBs -------------------------------------}ππ repeatπ beginπ write( chr( ord('A') + CurrDpbP^.Code ),{ display device code }π ': ');π DS := DS + chr(ord('A')+CurrDpbP^.Code);π if CurrDpbP^.Code > 0 thenπ beginπ Regs.AX := $440E;π Regs.BL := CurrDpbP^.Code;π MsDos(Regs);π if Regs.AL <> 0 thenπ writeln(' is actually mapped to ',π chr(ord('A')+pred(CurrDpbP^.Code)))π end;π if ((CurrDpbP^.FatNb > 0) AND (CurrDpbP^.FatNb < 2)) thenπ writeln(' (RAMDISK)');π end;π CurrDpbP := CurrDpbP^.Next; { set pointer to next DPB }π until ( Ofs( CurrDpbP^ ) = $FFFF ); { until last DPB is reached }π writelnπ end;ππProcedure DiskEval;π{computes statistics of disk chosen by user}ππvar Reg : registers;π Drive : char;π column,row : shortint;π SectorsPerCluster : Word;π AvailClusters : Word;π BytesPerSector : Word;π TotalClusters : Word;π BytesAvail,Clut : longint;π Kilos : extended;π ByAl : string25;π TotClut : string25;π OneClut : string25;π AvailClut : string25;πbeginπ write('');π column := whereX;π row := whereY;π repeatπ gotoXY(column,row);π write('Which drive to read from? ',' ',chr(8));π read(Drive);π Drive := UpCase(Drive);π until (pos(Drive,DrvStr) <> 0);π writeln;π with Reg do beginπ DL := ord(Drive) - 64;π AH := $36;π Intr($21,Reg);π SectorsPerCluster := AX;π AvailClusters := BX;π BytesPerSector := CX;π TotalClusters := DXπ end;π BytesAvail := longint(BytesPerSector) * longint(SectorsPerCluster)π * longint(AvailClusters);π Kilos := BytesAvail/1024;π clut := longint(SectorsPerCluster)*longint(BytesPerSector);π Str(BytesAvail,Byal);π Pinsert(Byal);π Str(AvailClusters,AvailClut);π Pinsert(AvailClut);π Str(Clut,OneClut);π Pinsert(OneClut);π Str(TotalClusters,TotClut);π Pinsert(Totclut);π clrscr;π if SectorsPerCluster <> 65535 thenπ beginπ write('For drive ');π HighVideo;π write(Drive);π LowVideo;π writeln(':');π writeln('Sectors per cluster: ',SectorsPerCluster);π writeln('Bytes per sector: ',BytesPerSector);π writeln('Total clusters: ',TotClut);π writeln('Available clusters: ',AvailClut);π write('(One cluster = ',oneclut,' bytes: the smallest');π writeln(' allocatable space!)');π write('A TOTAL of ',ByAl,' BYTES are AVAILABLE (',Kilos:6:3);π writeln(' K)') {previous line split for display: length <73 }π endπ else writeln('There is no diskette in drive ',Drive,': !')πend;ππbeginπ car := #0;π repeatπ DrvStr := '';π DrvLet := #0;π clrscr;π ver := Lo(DosVersion);π writeln('Installed logical drives are : '#13#10);π if ver < 4 thenπ GetDrives1(DrvStr)π elseπ GetDrives2(DrvStr);π DiskEval;π writeln;π write('type ''Y'' to continue, any other key to exit.');π car := upcase(readkey);π until (car <> 'Y')πend.π 62 01-27-9417:33ALL GREG VIGNEAULT Detecting CDROM Drives IMPORT 36 ╣═W {πFrom: GREG VIGNEAULTπSubj: Extended drives (CD-ROM)π---------------------------------------------------------------------------π In a message with STEVE ROGERS...πSR>PN> Is it acceptable and safe for the hardware to attempt to writeπSR> > a test file to a CD-Rom drive? I would do this to find out thatπSR> I tried this a few years ago and just got a write error. Should beπSR> safe enough.ππLD>Although... would you not get the same result as you would on aπ >write-protected disk, or a full disk, or one where the "test"π >file name is unacceptable?ππ Hi Lou,ππ I haven't been following this thread, so I don't know what all hasπ been said. I don't have a CD-ROM but I'll toss in some of the infoπ that I'm aware of...ππ Here is TP source that can detect if one or more CD-ROM is presentπ in a PC system, and the drive letter of the first CD-ROM. It triesπ to find if the Microsoft CD-ROM Extension (MSCDEX) is installed...π}ππ(*******************************************************************)πPROGRAM CDROM; { compiler: Turbo Pascal 4.0+ }π { Jan.07.94 Greg Vigneault }ππUSES Dos; { import Intr, Registers }πVAR DrvName : CHAR; { first extended drive (A: to Z:) }π DrvCount : WORD; { number of extended drives }π IsMSCDEX, { TRUE if MSCDEX is installed }π IsCDROM : BOOLEAN; { TRUE if extended drive is CDROM }ππ(*-----------------------------------------------------------------*)π{ Detect if/how-many extended drives (CD-ROMs) are in system ... }ππPROCEDURE CD_ROMdat ( VAR DrvCount : WORD; { total ext. drives }π VAR FirstDrv : CHAR; { first ext. drv }π VAR IsMSCDEX : BOOLEAN; { MSCDEX found? }π VAR IsCDROM : BOOLEAN); { is CD-ROM? }π VAR Reg : Registers; { to access 8086 CPU registers }π BEGIN {CD_ROMdat}π { initialize the VARs... }π FirstDrv := #0; { assume no extension drives }π IsMSCDEX := FALSE; { assume MSCDEX not installed }π IsCDROM := FALSE; { assume drive isn't a CD-ROM }π Reg.AX := $1500; { fn: check if CD-ROM is present }π Reg.BX := 0; { clear BX }π Intr ($2F, Reg); { invoke MSCDEX }π DrvCount := Reg.BX; { count of extended drives }π IF (DrvCount = 0) THEN EXIT; { abort if no extended drive }π FirstDrv := CHR (Reg.CX + 65); { first drive IN ['A'..'Z'] }π Reg.AX := $150B; { fn: CD-ROM drive check }π Reg.BX := 0; { Reg.CX already has drive # }π Intr ($2F, Reg); { call the CD-ROM services }π IF (Reg.BX <> $ADAD) THEN EXIT; { MSCDEX isn't installed }π IsMSCDEX := TRUE; { MSCDEX is installed }π IF (Reg.AX = 0) THEN EXIT; { ext. drive isn't a CD-ROM }π IsCDROM := TRUE; { extended is a CD-ROM }π END {CD_ROMdat}; { END PROCEDURE DC_ROMdat }ππ(*-----------------------------------------------------------------*)πBEGIN {PROGRAM CDROM}ππ CD_ROMdat (DrvCount, DrvName, IsMSCDEX, IsCDROM);π WriteLn;ππ IF (DrvCount <> 0) THEN BEGINπ IF IsMSCDEX THEN WriteLn ('MSCDEX is installed');π Write ('Extended drive(s) detected');π IF IsCDROM THEN Write (' (CD-ROM)');π WriteLn (' = ',DrvCount,' at ',DrvName,':');π END {IF DrvCount}π ELSEπ WriteLn ('No extended drives (CD-ROMs) detected in system.');ππ WriteLn;ππEND {CDROM}.π(*******************************************************************)ππ The familiar Int21h file i/o can be used for reading files on anπ extended drive. The MSCDEX also offers the following extendedπ functions...ππ o Get CD-ROM Drive Listπ o Get Copyright Filenameπ o Get Abstract Filenameπ o Get Bibliographic Filenameπ o Read Volume Table of Contentsπ o Absolute Disk Readπ o Absolute Disk Writeπ o Get CD-ROM Extensions Versionπ o Get CD-ROM Unitsπ o Get or Set Volume Descriptor Preferenceπ o Get Directory Entryπ o Send Device Requestππ Greg_π 63 01-27-9417:38ALL SWAG SUPPORT TEAM DOS Files Info IMPORT 20 ╣¼₧ unit FileInfo;π(* FILEINFO scans DOS' "list of lists" to retrieve valuable file information.π It does this by calling undocumented MSDOS call 52h. It should be notedπ that this only works for DOS versions 2.0 and higher. No error checkingπ for this is performed.π*)πinterfaceπusesπ dos;πtypeπ FileTblPtr = ^FileTables;π FileTables = recordπ Next: FileTblPtr;π NumFiles: word;π NumHandles: byte;π end; { FileTables }π ListofListsRec = recordπ DOSDriveParamBlock: pointer;π DOSFileTbl: FileTblPtr;π ClockDevice: pointer;π ConDevice: pointer;π MaxBytes: word;π DiskBuffer: pointer;π SubDirectory: pointer;π FCBTable: pointer;π FCBsProtected: word;π NumBlocks: byte;π LastDrive: byte;π end; { ListofLists }π DOSFilesObj = objectπ ListOfLists : ^ListofListsRec;π constructor Init;π function LastDrive : char;π function FilesUsed : integer;π function ConfigFiles : integer;π end; { ConfigObj }ππimplementationππconstructor DOSFilesObj.Init;πvarπ regs: registers;πbeginπ regs.ah := $52;π MsDos(regs); { call undocumented function 52h }π { returns pointer to list of lists @Regs.ES,Regs.BX }π ListofLists := Ptr(regs.ES,regs.BX);πend; { DOSFilesObj.Init }ππfunction DOSFilesObj.LastDrive : char;πbeginπ LastDrive := Char(ListofLists^.LastDrive+64);πend; { DOSFilesObj.LastDrive }ππfunction DOSFilesObj.FilesUsed : integer;πvarπ n: integer;π p: FileTblPtr;πbeginπ n := 0;π p := ListOfLists^.DOSFileTbl;π while ofs(p^)<>$FFFF doπ beginπ inc(n,p^.NumHandles);π p := p^.Next;π end; { while }π FilesUsed := n;πend; { DOSFilesObj.FilesUsed }ππfunction DOSFilesObj.ConfigFiles : integer;πvarπ n: integer;π p: FileTblPtr;πbeginπ n := 0;π p := ListOfLists^.DOSFileTbl;π while ofs(p^)<>$FFFF doπ beginπ inc(n,p^.NumFiles);π p := p^.Next;π end; { while }π ConfigFiles := n;πend; { DOSFilesObj.ConfigFiles }ππend. { FileInfo }ππ{-------------- DEMO ------------------ }ππprogram filetest;πuses fileinfo;πvarπ DOSFiles : DOSFilesObj;πbeginπ DOSFiles.Init;π Writeln('LASTDRIVE=',DOSFiles.LastDrive);π Writeln('DOS FILES USED=',DOSFiles.FilesUsed);π Writeln('DOS FILES=',DOSFiles.ConfigFiles);πend. { FileInfo } 64 01-27-9417:42ALL SWAG SUPPORT TEAM Get DOS Drives IMPORT 17 ╣┤┤ unit GetDrive;ππinterfaceπusesπ Crt;ππtypeπ TFCB = Recordπ Drive: Byte;π Name: array[0..7] of Char;π Ext: array[0..2] of Char;π CurBlock: Word;π RecSize: Word;π FileSize: LongInt;π FileDate: Word;π FileTime: Word;π Reserved: array[0..7] of Char;π CurRec: Byte;π RandRec: LongInt;π end;ππ TDBP = Recordπ Drive: Byte;π AUnit: Byte;π SectorSize: Word;π Rest: array[0..28] of Byte;π end;π PDBP = ^TDBP;πππprocedure GetDrives;ππimplementationπvarπ Sx: array[0..80] of Char;π FCBx: TFCB;π DBP: PDBP;ππfunction ISOK(Drive: Byte): Boolean; assembler;πasmπ push dsπ mov dl, Driveπ mov ah, 32hπ int 21hπ cmp al, $FFπ jz @errorπ mov cx, dsπ mov es, cxπ pop dsπ mov word ptr DBP, bxπ mov word ptr DBP + 2, esπ mov al, 1π jmp @Okπ@error:π pop dsπ mov al, 0π@Ok:πend;πππfunction GetInfo: Boolean; assembler;πasmπ push bpπ push dsπ mov si, seg Sxπ mov ds, siπ mov si, offset sxπ mov di, seg FCBxπ mov es, diπ mov di, offset fcbxπ mov al, 1π mov ah, 29hπ int 21hπ mov bl, alπ mov ax, 1π cmp bl, $FFπ jnz @Doneπ mov ax, 0π@Done:π pop dsπ pop bpπend;ππprocedure GetDrives;πvarπ S1: String;π i: Integer;π bad: Boolean;π S: PChar;ππbeginπ GetMem(S, 80);π S1 := 'c:*.*';π FillChar(FCBx, SizeOf(TFCB), #0);π for i := 0 to 25 do beginπ S1[1] := Chr(i + 65);π move(S1[1], Sx, Length(S1));π S[Length(S1)] := #0;π Bad := GetInfo;π if bad then beginπ Write(S1);π if (i = 0) or (i = 1) thenπ WriteLn(' -> Normal')π elseπ if IsOk(i+1) then WriteLn(' -> Normal')π else WriteLn(' -> Special');π end;π end;π FreeMem(S, 80);πend;πend.ππ{ ------------------------------- DEMO --------------------------- }ππ{π This code shows how to find information about which drivesπ exist on the system. It returns the information withoutπ ever causing an error message to appear on screen.ππ}πprogram Drives;πusesπ GetDrive,π Crt;ππbeginπ ClrScr;π GetDrives;π ReadLn;πend. 65 02-03-9407:06ALL MIKE CHAMBERS Volume Serial Number IMPORT 18 ╣TO πunit xdos;ππInterfaceπ function GetVolSerialNo(DriveNo:Byte): string;π Procedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);ππImplementationπuses dos,crt;ππtypeπ SerNo_type =π recordπ case integer ofπ 0: (SerNo1, SerNo2 : word);π 1: (SerNo : longint);π end;ππ DiskSerNoInfo_type = recordπ Infolevel : word;π VolSerNo : SerNo_Type;π VolLabel : array[1..11] of char;π FileSys : array[1..8] of char;π end;πππfunction HexDigit(N : Byte) : char;πbeginπ if n < 10 then HexDigit := Chr(Ord('0')+n)π else HexDigit := Chr(Ord('A') + (n - 10));πend;πππfunction GetVolSerialNo(DriveNo:Byte): string;πvarπ ReturnArray : DiskSerNoInfo_type;π Regs : Registers;πbeginπ with regs do beginπ AX := $440d;π BL := DriveNo;π CH := $08;π CL := $66;π DS := Seg(ReturnArray);π DX := Ofs(ReturnArray);π Intr($21,Regs);π if (Flags and FCarry)<>0 then GetVolSerialNo := '' elseπ with ReturnArray.VolSerNo doπ GetVolSerialNo :=HexDigit(Hi(SerNo2) Div 16) + HexDigit(Hi(SerNo2) Mod 16)π+π HexDigit(Lo(SerNo2) Div 16) + HexDigit(Lo(SerNo2) Mod 16)π+π HexDigit(Hi(SerNo1) Div 16) + HexDigit(Hi(SerNo1) Mod 16)π+π HexDigit(Lo(SerNo1) Div 16) + HexDigit(Lo(SerNo1) Mod 16);π end;πend;ππProcedure PutVolSerialNo(DriveNo:Byte;SerialNo:longint);πvarπ ReturnArray : DiskSerNoInfo_type;π Regs : Registers;πbeginπ with regs do beginπ AX := $440d;π BL := DriveNo;π CH := $08;π CL := $66;π DS := Seg(ReturnArray);π DX := Ofs(ReturnArray);π Intr($21,Regs);π if (Flags and FCarry)=0 then beginπ ReturnArray.VolSerNo.SerNo := SerialNo;π AH := $69;π BL := DriveNo;π AL := $01;π DS := Seg(ReturnArray);π DX := Ofs(ReturnArray);π Intr($21,Regs);π end;π end;πend;ππend.π 66 02-03-9410:49ALL BO BENDTSEN GIG Drive Size/Free IMPORT 13 ╣φf {πFrom: BO BENDTSENπSubj: Diskfree...ππ MT> Has anyone noticed the problem with TP returning the wrong values from theπ MT> DISKFREE function on large size HD's? We have a 2 gig drive at workπ MT> (actual total is like 1900000000 bytes free), and pascal returns somethingπ MT> like 576009491. All variables are longint.πππMany people does not think about it, but DOS is limited to report more thanπ1 gigabyte. Myself I have a 1.3 giga and a 1.0 giga, and made these routinesπfor my programs for knowing if the size is more than 1 giga. Using the normalπDiskSize and DiskFree could get you strange result, sometimes it could reportπmaybe 100MB when it is really 1 giga.ππIf the size og free space is 1 you can assume that the drive is more than 1πgigabyte.}ππFunction DriveSize(d:byte):Longint; { -1 not found, 1=>1 Giga }πVarπ R : Registers;πBeginπ With R Doπ Beginπ ah:=$36; dl:=d; Intr($21,R);π If AX=$FFFF Then DriveSize:=-1 { Drive not found }π Else If (DX=$FFFF) or (Longint(ax)*cx*dx=1073725440) Then DriveSize:=1π Else DriveSize:=Longint(ax)*cx*dx;π End;πEnd;ππFunction DriveFree(d:byte):Longint; { -1 not found, 1=>1 Giga }πVarπ R : Registers;πBeginπ With R Doπ Beginπ ah:=$36; dl:=d; Intr($21,R);π If AX=$FFFF Then DriveFree:=-1 { Drive not found }π Else If (BX=$FFFF) or (Longint(ax)*bx*cx=1073725440) Then DriveFree:=1π Else DriveFree:=Longint(ax)*bx*cx;π End;πEnd;π 67 02-03-9410:54ALL SWAG SUPPORT TEAM FILEIO2.PAS IMPORT 234 ╣⌡ {πFrom: GREG ESTABROOKSπSubj: FileIO.Pasπ---------------------------------------------------------------------------π}ππUNIT FILEIO; { Low Level File handling routines. Jan 18/94 }π { Copyright (C) 1993,1994 Greg Estabrooks }π { NOTE: Requires TP 6.0+ to compile. }πINTERFACEπ{***********************************************************************}πUSES DOS; { IMPORT FSearch. }πCONST { Handles PreDefined by DOS. }π fStdIn = $00; { STD Input Device, (Keyboard). }π fStdOut = $01; { STD Output Device,(CRT). }π fStdErr = $02; { STD Error Device, (CRT). }π fStdCom = $03; { STD Comm. }π fStdPrn = $04; { STD Printer. }π oRead = $00; { Opens a file for read only. }π oWrite = $01; { Opens a file for writing only. }π oReadWrite = $02; { Opens a file for reading and writing. }π oDenyAll = $10; { Deny access to other processes. }π oDenyWrite = $20; { Deny write access to other processes. }π oDenyRead = $30; { Deny read access to other processes. }π oDenyNone = $40; { Allow free access to other processes. }π { Possible file attribs,can be combined.}π aNormal = $00; aSystem = $04; aArchive = $20;π aReadOnly = $01; aVolume = $08;π aHidden = $02; aDir = $10;πTYPEπ LockType = (Lock,UnLock); { Ordinal Type for use with 'fLock'. }πVARπ fError :WORD; { Holds any error codes from routines. }ππPROCEDURE ASCIIZ( VAR fName :STRING );π { Routine to add a NULL to a string to make it }π { ASCIIZ compatible. }π { File routines automatically call this routine}π { usage : }π { ASCIIZ(fName); }ππFUNCTION fCreate( fName :STRING; Attr :BYTE ) :WORD;π { Routine to Create 'fName' with an attribute }π { of 'Attr'. If the file already exists then it}π { will be truncated to a zero length file. }π { Returns a WORD value containing the handle. }π { Uses Int 21h/AH=3Ch. }π { usage : }π { handle := fCreate('Temp.Dat',aNormal); }ππFUNCTION fOpen( fName :STRING; Mode :BYTE ) :WORD;π { Routine to open already existing file defined}π { in 'fName' with an opening mode of 'Mode'. }π { Returns a WORD value containing the handle. }π { Uses Int 21h/AH=3Dh. }π { usage : }π { handle := fOpen('Temp.Dat',oRead); }ππPROCEDURE fRead( fHandle :WORD; VAR Buff; NTRead:WORD; VAR ARead :WORD );π { Reads 'NTRead' bytes of data from 'fHandle' }π { and puts it in 'Buff'. The actually amount }π { of bytes read is returned in 'ARead'. }π { Uses Int 21h/AH=3Fh. }π { usage : }π { fRead(handle,Buffer,SizeOf(Buffer),ARead); }ππPROCEDURE fWrite( fHandle :WORD; VAR Buff; NTWrite:WORD; VAR AWrite :WORD );π { Writes 'NTWrite' bytes of info from 'Buff' }π { to 'fHandle'. The actually amount written is }π { returned in 'AWrite'. }π { Uses Int 21h/AH=40h. }π { usage : }π { fWrite(handle,Buffer,SizeOf(Buffer),AWrite);}ππPROCEDURE fClose( fHandle :WORD );π { Routine to close file 'fHandle'. This updates}π { the directory time and size enteries. }π { Uses Int 21h/AH=3Eh. }π { usage : }π { fClose(handle); }ππPROCEDURE fReset( fHandle :WORD );π { Routine to reset file position pointer to the}π { beginning of 'fHandle'. }π { Uses Int 21h/AH=42h. }π { usage : }π { fReset(handle); }ππPROCEDURE fAppend( fHandle :WORD );π { Routine to move the File position pointer of }π { 'fHandle' to the end of the file. Any further}π { writing is added to the end of the file. }π { Uses Int 21h/AH=42h. }π { usage : }π { fAppend(handle); }ππPROCEDURE fSeek( fHandle :WORD; fOfs :LONGINT );π { Routine to move the file position pointer for}π { 'fHandle' to 'fOfs'. 'fOfs' is the actual }π { byte position in the file to move to. }π { Uses Int 21h/AH=42h. }π { usage : }π { fSeek(handle,1023); }ππPROCEDURE fErase( fName :STRING );π { Routine to erase 'fName'. }π { Uses Int 21h/AH=41h. }π { usage : }π { fErase('Temp.Dat'); }ππFUNCTION fPos( fHandle :WORD ) :LONGINT;π { Routine to return the current position within}π { 'fHandle'. }π { Uses Int 21h/AH=42. }π { usage : }π { CurPos := fPos(handle); }ππFUNCTION fEof( fHandle :WORD ) :BOOLEAN;π { Routine to determine whether or not we're }π { currently at the end of file 'fHandle'. }π { usage : }π { IsEnd := fEof(handle); }ππFUNCTION fExist( fName :STRING ) :BOOLEAN;π { Routine to determine whether or not 'fName' }π { exists. }π { usage : }π { Exist := fExist('Temp.Dat'); }ππFUNCTION fGetAttr( fName :STRING ) :BYTE;π { Routine to return the current file attribute }π { of 'fName'. }π { Uses Int 21h/AH=43h,AL=00h. }π { usage : }π { CurAttr := fGetAttr('Temp.Dat'); }ππPROCEDURE fSetAttr( fName :STRING; NAttr :BYTE );π { Routine to set file attribute of 'fName' to }π { 'NAttr'. }π { Uses Int 21h/AH=43h,AL=01h. }π { usage : }π { fSetAttr('Temp.Dat',aArchive OR aReadOnly); }ππPROCEDURE fSetVerify( On_Off :BOOLEAN );π { Routine to set the DOS verify flag ON or OFF.}π { depending on 'On_Off'. }π { TRUE = ON, FALSE = OFF. }π { Uses Int 21h/AH=2Eh. }π { usage : }π { fSetVerify( TRUE ); }ππFUNCTION fGetVerify :BOOLEAN;π { Routine to return the current state of the }π { DOS verify flag. }π { Uses Int 21h/AH=54h. }π { usage : }π { IsVerify := fGetVerify; }ππFUNCTION fSize( fHandle :WORD ) :LONGINT;π { Routine to determine the size in bytes of }π { 'fHandle'. }π { usage : }π { CurSize := fSize(handle); }ππPROCEDURE fFlush( fHandle :WORD );π { Flushes any File buffers for 'fHandle' }π { immediately and updates the directory entry. }π { Uses Int 21h/AH=68h. }π { usage : }π { fFlush(handle); }ππPROCEDURE fLock( fHandle :WORD; LockInf :LockType; StartOfs,Len :LONGINT );π { Routine to lock/unlock parts of a open file. }π { Locking or unlock is determined by 'LockInf'. }π { Uses Int 21h/AH=5Ch. }π { usage : }π { fLock(handle,Lock,1000,500); }π{***********************************************************************}πIMPLEMENTATIONππPROCEDURE ASCIIZ( VAR fName :STRING ); ASSEMBLER;π { Routine to add a NULL to a string to make it }π { ASCIIZ compatible. }π { File routines automatically call this routine}πASMπ Push DS { Push DS onto the stack. }π LDS DI,fname { Point DS:DI ---> fName. }π Xor BX,BX { Clear BX. }π Mov BL,BYTE PTR DS:[DI] { Load length of string into BL. }π Inc BL { Point to char after last one in name. }π Mov BYTE PTR DS:[DI+BX],0 { Now make it a ASCIIZ string. }π Pop DS { Pop DS off the stack. }πEND;{ASCIIZ}ππFUNCTION fCreate( fName :STRING; Attr :BYTE ) :WORD;π { Routine to Create 'fName' with an attribute }π { of 'Attr'. If the file already exists then it}π { will be truncated to a zero length file. }π { Returns a WORD value containing the handle. }π { Uses Int 21h/AH=3Ch. }πBEGINπ ASCIIZ(fName); { Convert fName to an ASCIIZ string. }π ASMπ Push DS { Push DS Onto stack. }π Mov fError,0 { Clear Error Flag. }π Mov AX,SS { Load AX with SS. }π Mov DS,AX { Now load that value into DS. }π Lea DX,fName { Now load DX with the offset of DX. }π Inc DX { Move past length byte. }π Xor CH,CH { Clear High byte of CX. }π Mov CL,Attr { Load attribute to give new file. }π Mov AH,$3C { Function to create a file. }π Int $21 { Call dos to create file. }π Jnc @Exit { If no error exit. }π Mov fError,AX { If there was an error save it. }π @Exit:π Mov @Result,AX { Return proper result to user. }π Pop DS { Pop DS Off the Stack. }π END;πEND;{fCreate}ππFUNCTION fOpen( fName :STRING; Mode :BYTE ) :WORD;π { Routine to open already existing file defined}π { in 'fName' with an opening mode of 'Mode'. }π { Returns a WORD value containing the handle. }π { Uses Int 21h/AH=3Dh. }πBEGINπ ASCIIZ(fName); { Convert fName to an ASCIIZ string. }π ASMπ Push DS { Push DS onto stack. }π Mov fError,0 { Clear Error Flag. }π Mov AX,SS { Load AX with SS. }π Mov DS,AX { Now load that value into DS. }π Lea DX,fName { Now load DX with the offset of DX. }π Inc DX { Move past length byte. }π Mov AH,$3D { Function to open a file. }π Mov AL,Mode { File Opening mode. }π Int $21 { Call dos to open file. }π Jnc @Exit { If no error exit. }π Mov fError,AX { If there was an error save it. }π @Exit:π Mov @Result,AX { Return proper result to user. }π Pop DS { Restore DS from stack. }π END;πEND;{fOpen}ππPROCEDURE fRead( fHandle :WORD; VAR Buff; NTRead:WORD; VAR ARead :WORD );πASSEMBLER; { Reads 'NTRead' bytes of data from 'fHandle' }π { and puts it in 'Buff'. The actually amount }π { of bytes read is returned in 'ARead'. }π { Uses Int 21h/AH=3Fh. }πASMπ Push DS { Push DS onto the stack. }π Mov fError,0 { Clear Error flag. }π Mov AH,$3F { Function to read from a file. }π Mov BX,fHandle { load handle of file to read. }π Mov CX,NTRead { # of bytes to read. }π LDS DX,Buff { Point DS:DX to buffer. }π Int $21 { Call Dos to read file. }π LDS DI,ARead { Point to amount read. }π Mov WORD PTR DS:[DI],AX { Save amount actually read. }π Jnc @Exit { if there was no error exit. }π Mov fError,AX { If there was Save error code. }π@Exit:π Pop DS { Pop DS off the stack. }πEND;{fRead}ππPROCEDURE fWrite( fHandle :WORD; VAR Buff; NTWrite:WORD; VAR AWrite :WORD );πASSEMBLER; { Writes 'NTWrite' bytes of info from 'Buff' }π { to 'fHandle'. The actually amount written is }π { returned in 'AWrite'. }π { Uses Int 21h/AH=40h. }πASMπ Push DS { Push DS onto the stack. }π Mov fError,0 { Clear Error flag. }π Mov AH,$40 { Function to write to file. }π Mov BX,fHandle { Handle of file to write to. }π Mov CX,NTWrite { # of bytes to read. }π LDS DX,Buff { Point DS:DX -> Buffer. }π Int $21 { Call Dos to write to file. }π LDS DI,AWrite { Point to amount write. }π Mov WORD PTR DS:[DI],AX { Save amount actually written. }π Jnc @Exit { If there was no error exit. }π Mov fError,AX { if there was save error code. }π@Exit:π Pop DS { Pop DS off the stack. }πEND;{fWrite}ππPROCEDURE fClose( fHandle :WORD ); ASSEMBLER;π { Routine to close file 'fHandle'. This updates}π { the directory time and size enteries. }π { Uses Int 21h/AH=3Eh. }πASMπ Mov fError,0 { Clear Error flag }π Mov AH,$3E { Function to close file }π Mov BX,fHandle { load handle of file to close }π Int $21 { call Dos to close file }π Jnc @Exit { If there was no error exit }π Mov fError,AX { if there was save error code }π@Exit:πEND;{fClose}ππPROCEDURE fReset( fHandle :WORD ); ASSEMBLER;π { Routine to reset file position pointer to the}π { beginning of 'fHandle'. }π { Uses Int 21h/AH=42h. }πASMπ Mov fError,0 { Clear error flag. }π Mov AH,$42 { Function to move file pointer. }π Mov BX,fHandle { Handle of file. }π Mov AL,0 { Offset relative to begining. }π Mov CX,0 { CX:DX = offset from begining of file }π Mov DX,0 { to move to. }π Int $21 { Call dos to change file pointer. }π Jnc @Exit { If there was no error exit. }π Mov fError,AX { If there was save error code. }π@Exit:πEND;{fReset}ππPROCEDURE fAppend( fHandle :WORD); ASSEMBLER;π { Routine to move the File position pointer of }π { 'fHandle' to the end of the file. Any further}π { writing is added to the end of the file. }π { Uses Int 21h/AH=42h. }πASMπ Mov fError,0 { Clear error flag. }π Mov AH,$42 { Function to change file ptr position. }π Mov BX,fHandle { handle of file to change. }π Mov AL,$02 { Change relative to end of file. }π Mov CX,0 { CX:DX = offset from end of file }π Mov DX,0 { to move to. }π Int $21 { Call dos to move file ptr. }π Jnc @Exit { If there was no error exit. }π Mov fError,AX { If there was save error code. }π@Exit:πEND;{fAppend}ππPROCEDURE fSeek( fHandle :WORD; fOfs :LONGINT ); ASSEMBLER;π { Routine to move the file position pointer for}π { 'fHandle' to 'fOfs'. 'fOfs' is the actual }π { byte position in the file to move to. }π { Uses Int 21h/AH=42h. }πASMπ Mov fError,0 { Clear error flag. }π Mov AH,$42 { Function to change file ptr position. }π Mov BX,fHandle { handle of file to change. }π Mov AL,$00 { Change relative to start of file. }π Mov CX,fOfs[2].WORD { CX:DX = offset from start of file }π Mov DX,fOfs.WORD { to move to. }π Int $21 { Call dos to move file ptr. }π Jnc @Exit { If there was no error exit. }π Mov fError,AX { If there was save error code. }π@Exit:πEND;{fSeek}ππPROCEDURE fErase( fName :STRING );π { Routine to erase 'fName'. }π { Uses Int 21h/AH=41h. }πBEGINπ ASCIIZ(fName); { Convert fName to an ASCIIZ string. }π ASMπ Push DS { Push DS onto the stack. }π Mov fError,0 { Clear error flag. }π Mov AH,$41 { Function to erase a file. }π Mov AX,SS { Load AX with SS. }π Mov DS,AX { Now load that value into DS. }π Lea DX,fName { Now load DX with the offset of DX. }π Inc DXπ Int $21 { Call dos to erase file. }π Jnc @Exit { If no error exit. }π Mov fError,AX { if there was error save error code. }π @Exit:π Pop DS { Pop DS off the stack. }π END;πEND;{fErase}ππFUNCTION fPos( fHandle :WORD ) :LONGINT; ASSEMBLER;π { Routine to return the current position within}π { 'fHandle'. }π { Uses Int 21h/AH=42. }πASMπ Mov fError,0 { Clear error flag. }π Mov AH,$42 { Function to move file pointer. }π Mov BX,fHandle { Handle of file. }π Mov AL,1 { Offset relative to current pos. }π Mov CX,0 { CX:DX = offset from current position }π Mov DX,0 { to move to. }π Int $21 { Call dos to change file pointer. }π Jnc @Exit { If there was no error return result. }π Mov fError,AX { If there was save error code. }π@Exit: { Int already returns DX:AX as file pos.}πEND;{fPos}ππFUNCTION fEof( fHandle :WORD ) :BOOLEAN;π { Routine to determine whether or not we're }π { currently at the end of file 'fHandle'. }πVARπ CurOfs :LONGINT; { current file offset. }πBEGINπ CurOfs := fPos(fHandle); { Save Current Pos. }π fAppend(fHandle); { Move to the end of the file. }π fEof := (CurOfs = fPos(fHandle)); { was current pos = end pos?. }π fSeek(fHandle,CurOfs); { Restore to original file position. }πEND;{fEof}ππFUNCTION fExist( fName :STRING ) :BOOLEAN;π { Routine to determine whether or not 'fName' }π { exists. }πBEGINπ fExist := ( FSearch(fName,'') <> '');πEND;{fExist}ππFUNCTION fGetAttr( fName :STRING ) :BYTE;π { Routine to return the current file attribute }π { of 'fName'. }π { Uses Int 21h/AH=43h,AL=00h. }πBEGINπ ASCIIZ(fName); { Convert fName to an ASCIIZ string. }π ASMπ Push DS { Push DS onto the stack. }π Mov fError,0 { Clear error flag. }π Mov AX,SS { Load AX with SS. }π Mov DS,AX { Now load that value into DS. }π Lea DX,fName { Now load DX with the offset of DX. }π Inc DXπ Mov AX,$4300 { Function to Get file Attrib. }π Int $21 { Call dos to get attr. }π Jnc @Success { If no error return proper info. }π Mov fError,AX { if there was error save error code. }π @Success:π Mov AX,CXπ Mov @Result,AL { Return proper result to user. }π Pop DS { Pop DS off the stack. }π END;πEND;{fGetAttr}ππPROCEDURE fSetAttr( fName :STRING; NAttr :BYTE );π { Routine to set file attribute of 'fName' to }π { 'NAttr'. }π { Uses Int 21h/AH=43h,AL=01h. }πBEGINπ ASCIIZ(fName); { Convert fName to an ASCIIZ string. }π ASMπ Push DS { Push DS onto the stack. }π Mov fError,0 { Clear error flag. }π Mov AX,SS { Load AX with SS. }π Mov DS,AX { Now load that value into DS. }π Lea DX,fName { Now load DX with the offset of DX. }π Inc DX { Point to first char after length byte.}π Xor CX,CX { Clear CX. }π Mov CL,NAttr { Load New attribute byte. }π Mov AX,$4301 { Function to Set file Attrib. }π Int $21 { Call dos to set attrib. }π Jnc @Exit { If no error exit. }π Mov fError,AX { if there was error save error code. }π @Exit:π Pop DS { Pop DS off the stack. }π END;πEND;{fSetAttr}ππPROCEDURE fSetVerify( On_Off :BOOLEAN ); ASSEMBLER;π { Routine to set the DOS verify flag ON or OFF.}π { depending on 'On_Off'. }π { TRUE = ON, FALSE = OFF. }π { Uses Int 21h/AH=2Eh. }πASMπ Mov AH,$2E { Interrupt Subfunction. }π Mov DL,0 { Clear DL. }π Mov AL,On_Off { 0(FALSE) = off, 1(TRUE) = on. }π Int $21 { Call Dos. }πEND;{fSetVerify}ππFUNCTION fGetVerify :BOOLEAN; ASSEMBLER;π { Routine to return the current state of the }π { DOS verify flag. }π { Uses Int 21h/AH=54h. }πASMπ Mov AH,$54 { Interrupt Subfunction }π Int $21 { Call Dos }πEND;{fGetVerify}ππFUNCTION fSize( fHandle :WORD ) :LONGINT;π { Routine to determine the size in bytes of }π { 'fHandle'. }πVARπ CurOfs :LONGINT; { Holds original file pointer. }πBEGINπ CurOfs := fPos(fHandle); { Save current file pointer. }π fAppend(fHandle); { Move to end of file. }π fSize := fPos(fHandle); { Save current pos which equals size. }π fSeek(fHandle,CurOfs); { Restore original file pos. }πEND;{fSize}ππPROCEDURE fFlush( fHandle :WORD ); ASSEMBLER;π { Flushes any File buffers for 'fHandle' }π { immediately and updates the directory entry. }π { Uses Int 21h/AH=68h. }πASMπ Mov fError,0 { Clear error flag. }π Mov AH,$68 { Function to Commit file to disk. }π Mov BX,fHandle { Load handle of file to Commit. }π Int $21 { Call dos to flush file. }π Jnc @Exit { If no error exit. }π Mov fError,AX { if there was error save error code. }π@Exit:πEND;{fSetAttr}ππPROCEDURE fLock( fHandle :WORD; LockInf :LockType; StartOfs,Len :LONGINT );π { Routine to lock/unlock parts of a open file. }πASSEMBLER; { Locking or unlock is determined by 'LockInf'. }π { Uses Int 21h/AH=5Ch. }ππASMπ Mov fError,0 { Clear Error Flag. }π Mov AH,$5C { Function to lock/unlock part of a file.}π Mov AL,LockInf { Load whether to lock/unlock file area.}π Mov BX,fHandle { Handle of file to lock. }π Mov CX,StartOfs.WORD[0] { Load StartOfs Into CX:DX. }π Mov DX,StartOfs.WORD[2]π Mov SI,Len.WORD[0] { Load Len Into SI:DI. }π Mov DI,Len.WORD[2]π Int $21 { Call dos to lock area. }π Jnc @Exit { If no error exit. }π Mov fError,AX { If there was an error save it. }π@Exit:πEND;{fLock}ππBEGINπEND.{FileIO}π 68 02-03-9416:16ALL GREG VIGNEAULT Network Drives IMPORT 32 ╣-R {π >Hi, I'm interested in trying to identify what type of drive aπ >logical drive is (specifically, whether or not a hard drive isπ >a network drive; I want the installation program I'm writingπ >to prevent the user from installing to a network drive).ππ Hi Jim,ππ I don't have access to a network, but the following code willπ consistently assure me that my drives are all local ;) ... }ππ(************************* NETDRV.PAS ******************************)πPROGRAM NetDrive; { compiler: Turbo Pascal 4.0+ }π { Jan.17.94 Greg Vigneault }ππUSES Dos; { import MsDos, Registers }ππCONST Beep = CHR(7); { ASCII bell-tone }ππVAR Reg : Registers; { to use CPU registers }π DosErrorCode : WORD; { MsDos function error code }π DriveID : String[1]; { for PC/AT drive 'A'..'Z' }π DriveIsRemote : BOOLEAN; { TRUE or FALSE, of course }ππ(*-----------------------------------------------------------------*)π(* Return PC/MS-DOS version, times 100 (eg. 310 = version 3.1) ... *)ππFUNCTION DosVersion : WORD;π BEGINπ Reg.AX := $3000; { Dos fn: get Dos version }π MsDos (Reg); { call the Dos services }π DosVersion := WORD(Reg.AL) * 100 + WORD(Reg.AH); { convert }π END {DosVersion};ππ(*-----------------------------------------------------------------*)π(* Return TRUE if Drive is redirected to a network server... *)ππFUNCTION NetworkDrive (Drive:CHAR):BOOLEAN;π BEGINπ Drive := UpCase (Drive); { Drive _must_ be 'A'..'Z' }π IF (Drive IN ['A'..'Z']) THEN BEGIN { make sure of 'A'..'Z' }π Reg.BL := ORD(Drive) - 64; { 1 = A:, 2 = B:, 3 = C: etc. }π Reg.AX := $4409; { Dos fn: check if dev remote }π MsDos (Reg); { call Dos' services }π IF ODD(Reg.FLAGS) THEN { Dos reports function error? }π DosErrorCode := Reg.AX { yes: return Dos' error code }π ELSE BEGIN { else ... }π DosErrorCode := 0; { 0 = no error was detected }π IF ODD(Reg.DX SHR 12) THEN { is Drive remote? }π NetworkDrive := TRUE { yes: return TRUE }π ELSEπ NetworkDrive := FALSE; { no: return FALSE }π {END IF ODD(Reg.DX...}π END; {IF ODD(Reg.FLAGS)}π END; {IF Drive}π END {NetworkDrive};ππ(*-----------------------------------------------------------------*)πBEGIN {NetDrive}ππ WriteLn;ππ IF (ParamCount <> 1) THEN BEGIN { user input? }π WriteLn ('Usage: NETDRV <DriveLetter>',Beep); { no: offer hint }π HALT (1); { abort program }π END;ππ IF (DosVersion < 310) THEN BEGIN { check DOS ver }π WriteLn ('DOS version 3.1+ is needed.',Beep); { version too low }π HALT (2); { abort program }π END;ππ DriveID := ParamStr(1); { get user's input }π DriveID[1] := UpCase (DriveID[1]); { to uppercase }π DriveIsRemote := NetWorkDrive (DriveID[1]); { check per netwrok }ππ { _ALWAYS_ check if the function call failed.................... }ππ IF (DosErrorCode <> 0) THEN BEGIN { any DOS errors? }π WriteLn ('!DOS error #',DosErrorCode,Beep); { DOS fn failed }π HALT (3); { abort program }π END;ππ Write ('Drive ',DriveID[1],': is '); { inform user of }π IF NOT DriveIsRemote THEN Write ('NOT '); { the drive status }π WriteLn ('redirected to a network.');ππEND {NetDrive}.π(*******************************************************************)π 69 02-05-9407:56ALL MARTIN RICHARDSON Get Valid DOS Drives IMPORT 30 ╣Ç^ {πHere is my DRIVES routine again to return all valid drive letters on aπPC. This is a fix from the last version which incorrectly addressedπthe local variables and wound up hosing memory. I also added someπextensive comments for readability. Enjoy! }ππ{*****************************************************************************π * Function ...... Drivesπ * Purpose ....... To return a string containing the valid drives for theπ * current system.π * Parameters .... Noneπ * Returns ....... A string of the valid drive letters.π * Notes ......... Rather than changing to each drive to see if it exists, weπ * can instead call DOS Function 26h - Parse a file name.π * If the file name is invalid (eg, F:), then DOS will sayπ * so. So, by testing each drive letter as a file name,π * DOS will tell us which are good and which are bad!π * Author ........ Martin Richardsonπ * Date .......... August 6, 1993π * Update ........ 02-01-94: Corrected problem where local VAR variables wereπ * not being used, but a random memory location wasπ * instead!π * : Added comments for clarity.π *****************************************************************************}πFUNCTION Drives: STRING; ASSEMBLER;πVARπ DriveInfo: ARRAY[1..2] OF CHAR;π Buffer: ARRAY[1..40] OF CHAR;π DriveString: ARRAY[1..25] OF CHAR;πASMπ PUSH SI { Save Important Registers }π PUSH DIπ PUSH ESπ PUSH DSππ MOV SI, SS { The Stack Segment (SS) points to the }π MOV DS, SI { VAR's above. Point DS to it... }π PUSH DSπ POP ES { ...and ES as well. }ππ LEA SI, DriveInfo { DS:SI - Where we test each drive letter }π LEA DI, Buffer { ES:DI - FCB Buffer }π LEA BX, DriveString { DS:BX - Our resultant string }ππ MOV BYTE PTR [SI], '@' { The character before 'A' }π XOR CX, CX { Zero out CX }ππ@Scan:π INC BYTE PTR [SI] { Next Drive Letter }π MOV BYTE PTR [SI+1], ':'π MOV AX, $2906 { DOS Function 29h - Parse Filename }π INT 21h { DS:SI - String to be parsed }π { ES:DI - FCB }π LEA SI, DriveInfo { DS:SI }π CMP AL, $FF { AL = FFh if function fails (invalid }π JE @NotValid { drive letter) }ππ INC CX { Add one more to our string length... }π PUSH CX { ...and save it. }π MOV CL, BYTE PTR DS:[SI] { Grab the valid drive letter... }π MOV [BX], CL { ...and stuff it into our result }π INC BX { Next position in result string }π POP CX { Get our length counter back }ππ@NotValid:π CMP BYTE PTR [SI], 'Z' { Did we go through all letters? }π JNE @Scan { Nope, so next letter }ππ LEA SI, DriveString { Store DriveString to #Result }π LES DI, @Resultπ INC DIπ REP MOVSBππ XCHG AX, DI { This is the only way to store the }π MOV DI, WORD PTR @Result { length that I can get to work. }π SUB AX, DIπ DEC AXπ STOSBππ POP DS { Restore Important Registers }π POP ESπ POP DIπ POP SIπEND;ππ 70 02-15-9407:56ALL SWAG SUPPORT TEAM ASM Drive Valid Function IMPORT 9 ╣a▀ function DriveValid(Drive: Char): Boolean; assembler;πasmπ mov ah, 19h { Select DOS function 19h }π int 21h { Call DOS for current disk drive }π mov bl, al { Save drive code in bl }π mov al, Drive { Assign requested drive to al }π sub al, 'A' { Adjust so A:=0, B:=1, etc. }π mov dl, al { Save adjusted result in dl }π mov ah, 0eh { Select DOS function 0eh }π int 21h { Call DOS to set default drive }π mov ah, 19h { Select DOS function 19h }π int 21h { Get current drive again }π mov cx, 0 { Preset result to False }π cmp al, dl { Check if drives match }π jne @@1 { Jump if not--drive not valid }π mov cx, 1 { Preset result to True }π@@1:π mov dl, bl { Restore original default drive }π mov ah, 0eh { Select DOS function 0eh }π int 21h { Call DOS to set default drive }π xchg ax, cx { Return function result in ax }πend;π 71 05-25-9408:14ALL MIGUEL MARTINEZ File Allocation Unit SizeSWAG9405 10 ╣ºy {π ▒ Anybody know a realitively easy way to determine the file allocationπ ▒ unit size offa hard/floppy drive?? Pascal source would be prefered overπ ▒ pascal assembly as I know next to nothing about assembly.π}π{───────────────────────────────────────────────────────────────}πFunction GetUA(Drive: Byte:LongInt; {0=Default, 1=A, 2=B,..etc .}πVar regs:Registers;πBeginπ regs.ah:=$1C; { Int 21h, Function 1Ch: Get drive data }π { * Parameters: }π regs.dl:=Drive; { DL = Drive code }π intr($21,regs); { Call function. }π { * Returns: }π { AL = Sectors per cluster }π { DS:DX = Segment:Offset of ID byte }π { CX = Physical sector length (bytes) }π { DX = Number of clusters of default unit }π GetUA:=regs.al*regs.cx; { Returns SPC*SL }πEnd;π 72 05-25-9408:27ALL LEE ARONER Default Boot Drive SWAG9405 145 ╣Ñ) {$A+,B-,D+,E-,F-,G-,I+,L-,N-,O-,R-,S-,T-,V-,X+}π{$M 3072,0,0}ππ(* A program to test some interesting behaviour of Int 21h,π function 44h subfunction 08h.....the MicroSoft documentation Iπ have seen indicates only that this returns an error if the flagsπ register is set. however, it seems that it also identifies theπ default bootable logical drive, whether the machine was bootedπ from a floppy, and discriminates between Ram drives and normalπ HDrives.....& more! Would appreciate your assistance inπ running this test and returning this information to me by mail.π The results will be published in the FIDO Pascal echo.ππ **************** WARNING *****************π Although this program has run completely safely on all machinesπ tested by me, you should shut down or save all critical processesπ before running this test.ππ L.R.A. 5/6/94 *)ππProgram TestDisk;ππUses Dos;ππConstπ TapeDrive = $01;π CdRom = $02;π Floppy = $03; (* Old 8 inch & ALL Floppies *)π Floppy360 = $04; (* Also 320K Floppy *)π Floppy720 = $05;π Floppy12 = $06;π Floppy14 = $07;π Floppy28 = $08;π Floptical = $09;π Bernoulli = $0a;π RamDrive = $0b;π HardDrive = $0c;π BootHrdDrive = $0d; (* Default HARD-Disk BootDrive !!! *)ππ DriveTypes : array[0..13] of string[12] =π ('ERROR !', 'TapeDrive', 'CdRom',π 'Floppy', '360K Floppy', '720K Floppy',π '1.2M Floppy', '1.44M Floppy', '2.88M Floppy',π 'Floptical', 'Bernoulli', 'RamDrive',π 'HardDrive', 'BootHrdDrive');ππVarπ i : byte;π bits : string[16];π buff : array [0..2047] of byte;π drive : char;π Dtype : byte;π f : text;π y,m,d,dow : word;π lastdrive : byte;π regs : registers;π version : word;ππ(*------------------------------------------------------*)πFunction BinStr(num:word;bits:byte):string; assembler;πASMπ PUSHFπ LES DI, @Resultπ XOR CH, CHπ MOV CL, bitsπ MOV ES:[DI], CLπ JCXZ @@3π ADD DI, CXπ MOV BX, numπ STDπ@@1: MOV AL, BLπ AND AL, $01π OR AL, $30π STOSBπ SHR BX, 1π LOOP @@1π@@3: POPFπEnd;ππ(*------------------------------------------------------*)πFunction DosVersion : word;πBeginπ with regs doπ beginπ ax := $3000;π Intr($21,regs);π DosVersion := (word(al)*100)+word(ah);π end;πEnd;ππ(*---------------------------------------------------------*)π (* Uses Undocumented function 52h to return actual logicalπ lastdrive even under Novell and even if LastDrive is notπ used in Config.Sys. Must be DOS 3.1 or higher !!π Return is 1 based ie: A=1, B=2, C=3, etc. !!!!ππ Note: this will always return 5 if lastdrive is notπ specified in config.sys, even if less then 5 drives ! *)ππFunction GetLastDrive(Var Drives:byte):boolean;πBeginπ With regs doπ beginπ ah := $52; (* Return pointer to List of Lists *)π es := 0;π bx := 0;π Intr($21,regs);π (* This offset is ONLY valid for DOS 3.1 and above !! *)π Drives := Mem[es:bx+$21];π GetLastDrive := (Drives <> $FF)π AND ((es <> 0) AND (bx <> 0));π end;πEnd;ππ(*-----------------------------------------------------------*)π(* Switches to requested drive and then checks for error -π Be sure to call this with Drive UpCased !! - Should work OKπ with networks ??????? *)ππFunction DriveValid(drive: char): boolean; assembler;πasmπ mov ah, 19h { Select DOS sub function 19h }π int 21h { Call DOS for current disk drive }π mov bl, al { Save drive code in bl }π mov al, Drive { Assign requested drive to al }π sub al, 'A' { Adjust so A:=0, B:=1, etc. }π mov dl, al { Save adjusted result in dl }π mov ah, 0eh { Select DOS sub function 0eh }π int 21h { Call DOS to set default drive }π mov ah, 19h { Select DOS sub function 19h }π int 21h { Get current drive again }π mov cx, 0 { Preset result to False }π cmp al, dl { Check if drives match }π jne @@1 { Jump if not--drive not valid }π mov cx, 1 { Preset result to True }π@@1:π mov dl, bl { Restore original default drive }π mov ah, 0eh { Select DOS sub function 0eh }π int 21h { Call DOS to set default drive }π xchg ax, cx { Return function result in ax }πEnd;π(*-----------------------------------------------------*)π (* Be sure to call this with drive UpCased ! *)ππFunction IsCDRom(drive : char) : boolean;πBeginπ with regs doπ beginπ ax := $150b;π bx := $0000;π cx := word(ord(drive)-65);π Intr($2f,regs);π (* If MSCDEX is loaded, bx will be $adad ! *)π IsCDRom := (ax <> 0) AND (bx = $adad);π end;πEnd;ππ(*-----------------------------------------------------*)π (* Returns false if drive is local - untested !!! *)ππFunction DriveIsRemote(drive : char):boolean;πBeginπ with regs doπ beginπ ah := $44;π al := $09;π bl := ord(drive)-64;π Intr($21,regs);π DriveIsRemote := ((dx AND $1000) <> 0) AND (fCarry = 0);π (* Can further check if drive is substituted withπ dx AND $8000 = $8000 if so *)π end;πEnd;ππ(*------------------------------------------------------*)π (* Be sure that Drive is UPCASED !π Returns FALSE on Anything that is NOT a HardDisk,π including RamDisks, CdRom, etc. *)ππFunction IsHardDisk(drive:char):boolean;πBeginπ with regs DOπ beginπ ah := $44;π al := $08;π bl := ord(drive)-64;π Intr($21, regs);π IsHardDisk := (flags AND fCarry <> fCarry)π AND (NOT (ax in [$0,$0f]));π (* ax = $0 for removable, $0f on invalid drive spec ! *)π end;πEnd;ππ(*------------------------------------------------------------------*)π (* CAUTION !!!!! THIS FUNCTION IS EXPERIMENTAL !!!!!!!!! *)ππ (* Be sure that drive is UPCASED ! - This function goes to DOSπ internal structures to get params for floppy type drives.π (Including Bernoulli). Because it tells DOS to rebuild theπ BPB (Bios Parameter Block) for drives with removable media,π the Media Descriptor byte will always return the bootπ paramaters for the drive, ie: a 1.44M floppy will alwaysπ return 1.44M, regardless of the size disk that is currentlyπ actually in the drive !!ππ A return of BootHrdDrive indicates ONLY that this is theπ HardDrive with the DOS boot partition on it. It DOES NOTπ indicate that the machine was booted from that drive !!!ππ Dos version is MINIMUM of 3.1 !! - Check FIRST !!ππ Because it does NOT read the drive, this puppy is FAST !!ππ Returns these Constant types :π ERROR ! = $00;π TapeDrive = $01π CdRom = $02;πCheck against this- Floppy = $03; -to get All floppys !!π Floppy360 = $04;π Floppy720 = $05;π Floppy12 = $06;π Floppy14 = $07;π Floppy28 = $08;π Floptical = $09;π Bernoulli = $0a;π RamDrive = $0b;π HardDrive = $0c;π BootHrdDrive = $0d; *)ππFunction DriveType(Var f:text;drive:char):byte;πTypeπ PtrDpbPtr = ^DpbPtr;π DpbPtr = ^DPB;ππ DPB = record (* Drive Parameter Block *)π DN : byte; (* 0=A etc Can compare this for Subst drive *)π DDU : byte; (* Device Driver Unit Number *)π BPS : word; (* Bytes Per Sector *)π SPC : byte; (* Sectors Per Cluster *)π CSC : byte; (* Cluster Shift Count *)π BS : word; (* Boot Sectors *)π Fats : byte; (* Number of fats *)π RDE : word; (* Max Root Dir entries *)π FDS : word; (* First Data Sector *)π HPC : word; (* Highest Possible Cluster # *)π (* Case Variant *)π Case byte ofπ (* DOS < 4.0 OR OS2 *)π 0 : (SpfOld : byte; (* Sectors per fat *)π JunkOld : array[16..22] of byte;π MdaOld : byte; (* Media Descriptor byte *)π DummyOld : byte;π NextOld : DpbPtr); (* Pointer to next record *)π (* DOS >= 4.0 *)π 1 :(SpfNew : word;π JunkNew : array[17..23] of byte;π MdaNew : byte;π DummyNew : byte;π NextNew : DpbPtr);π end;πVarπ dnum,i,π num : byte;π CurrDpB : DpbPtr;π MDA : byte;π SPF : word;π params : array[0..31] of byte;π UseNew : boolean;ππBeginπ DriveType := 0; (* Assume failure *)π dnum := ord(drive)-64; (* 'A'=1, 'B'=2 etc. *)π with regs doπ beginπ ah := $44;π al := $08;π bl := dnum;π Intr($21, regs);π if ax = $0f then exit; (* Invalid drive ! *)π (* Here's where we try the undocumented return params ! *)π num := (ax+(flags AND fCarry)+(flags AND fParity));ππ { if (ax = 0) then - Diversion for test purposes !π begin }π (* OS2 will return > 10 *)π UseNew := Lo(DosVersion) in [4..9];ππ (* Get Ptr to List of Lists *)π ah := $52;π es := 0;π bx := 0;π Intr($21,regs);π if (es = 0) OR (bx = 0) then exit; (* Error ! *)ππ (* Pointer to list - 0h is pointer to 1st DPB *)π CurrDpb := PtrDpbPtr(Ptr(es,bx))^;π (* Walk the chain of DPB's to our drive: 0='A' etc. *)π (* Possible that drive is SUBSTed, so index from dnum instead of DN ! *)π (* Don't index on 'A', cause it's already there ! *)π for i := 2 to dnum doπ beginπ (* Offset set to $ffff on last in chain *)π if (ofs(CurrDpb^) <> $ffff) thenπ beginπ if UseNew then CurrDpb := CurrDpb^.NextNewπ else CurrDpb := CurrDpb^.NextOld;π endπ (* Hit end of chain before got to our drive ! *)π else exit;π end; (* Of for *)ππ Case UseNew ofπ (* >= DOS 4.0 and NOT OS2 *)π true : beginπ MDA := CurrDpb^.MdaNew;π SPF := CurrDpb^.SpfNew;π end;π (* < DOS 4 or OS2 *)π false : beginπ MDA := CurrDpb^.MdaOld;π SPF := CurrDpb^.SpfOld;π end;π end; (* Of case *)ππ (* Write out buncha stuff for analysis *)π writeln(f,'DN is : ',CurrDpb^.DN);π writeln(f,'DDU is : ',CurrDpb^.DDU);π writeln(f,'BPS is : ',CurrDpb^.BPS);π writeln(f,'SPC is : ',CurrDpb^.SPC);π writeln(f,'CSC is : ',CurrDpb^.CSC);π writeln(f,'BS is : ',CurrDpb^.BS);π writeln(f,'FATS is : ',CurrDpb^.Fats);π writeln(f,'RDE is : ',CurrDpb^.RDE);π writeln(f,'FDS is : ',CurrDpb^.FDS);π writeln(f,'HPC is : ',CurrDpb^.HPC);π writeln(f,'SPF is : ',SPF);π writeln(f,'MDA is : ',MDA);ππ (* This work on last of multiple Benoulli drives ???? *)π if (SPF > 2) AND (MDA >= $fc) thenπ DriveType := Bernoulliπ elseπ if num = 0 thenπ beginπ (* Tell DOS to build new BPB for removable types *)π fillchar(params,sizeof(params),0);π params[0] := 4; (* Do NOT go to drive ! *)π ax := $440d;π cx := $0860;π bl := dnum;π dx := ofs(params);π ds := seg(params);π Intr($21, regs);π Case params[1] ofπ 0 : DriveType := Floppy360;π 1 : DriveType := Floppy12;π 2 : DriveType := Floppy720;π 3,4 : DriveType := Floppy;π 6 : DriveType := TapeDrive;π 7 : DriveType := Floppy14;π 8 : DriveType := Floptical;π 9 : DriveType := Floppy28;π end;π beginπ writeln(f,'Params[1] is : ',byte(params[1]));π writeln(f,'BPS is : ',word(params[7]));π writeln(f,'SPC is : ',byte(params[9]));π writeln(f,'Fats is : ',byte(params[12]));π writeln(f,'RDE is : ',word(params[13]));π writeln(f,'SPF is : ',word(params[18]));π writeln(f,'MDA is : ',byte(params[17]));π end;π end (* Of Not Bernoulli *)π { end}π else (* ax > 0 ! *)π beginπ Case num ofπ 1 : DriveType := HardDrive;π 5 : DriveType := BootHrdDrive;π 6 : beginπ if IsCdRom(drive) thenπ DriveType := CDRomπ else DriveType := RamDrive;π end;π else DriveType := 0; (* Error ! *)π end; (* Of case *)π end; (* Not a floppy or bernoulli *)π end; (* With regs *)πEnd;πππππBegin (* TestDisk *)π GetDate(y,m,d,dow);π {$I-}π assign(f,'TESTDISK.RPT');π rewrite(f);π if IoResult <> 0 thenπ beginπ write(^G);π writeln('Can''t open report file: aborting !');π exit;π end;π SetTextBuf(f,buff);π writeln(f);π writeln(f,'DOS Drive Detection Survey Report');π writeln(f);π writeln(f,'Please mail to: CDC Micro');π writeln(f,' PO Box 4457');π writeln(f,' Seattle WA 98104');π writeln(f,' (206) 435-1125');π writeln(f);π writeln(f,'Thanks for taking the time to help with this survey !');π writeln(f);π writeln(f,'Report dated : ',m:0,'/',d:0,'/',y:0);π writeln(f);π writeln(f,'Report submitted by : _________________________________________________________');π writeln(f,'My address & phone # is : _____________________________________________________');π writeln(f,'_______________________________________________________________________________');π writeln(f,'Test equipment is : ___________________________________________________________');π writeln(f,'_______________________________________________________________________________');π writeln(f,'For this test, my machine was booted from the: _______ drive.');π writeln(f,'For this test, I was running a RamDisk on Drive: ______,using _________________');π writeln(f,'For this test, I had a Bernoulli drive connected as Drive: ________ (Yes/No?)');π writeln(f,'For this test, I had a Tape/Optical drive connected as Drive: _______ (Yes/No?)');π writeln(f,'For this test, I was running Stacker/DoubleSpace/Other compressor. (Yes/No ?)');π writeln(f,'Test Conducted under : __________________________ operating/system/environment');π writeln(f,'Comments ? ____________________________________________________________________');π writeln(f);π version := DosVersion;π writeln(f,'DOS Version: ',version);π if (version < 310) OR (NOT GetLastDrive(lastdrive)) thenπ writeln(f,'Dos Version too low or lastdrive detection FAILED !!')π else beginπ writeln(f,'LastDrive is: ',lastdrive:0);π writeln(f);π for i := 1 to lastdrive do with regs doπ beginπ drive := char(i+64);π if DriveValid(drive) thenπ beginπ IsHardDisk(drive);π Dtype := ax+(flags AND fCarry)+(flags AND fParity);π bits := BinStr(flags,16);π writeln(f,'Drive '+Drive+': Value of AX is: ',ax);π writeln('Drive '+Drive+': Value of AX is: ',ax);π writeln(f,'Drive '+Drive+': Value of flags is: ',flags);π writeln('Drive '+Drive+': Value of flags is: ',flags);π writeln(f,'Drive '+Drive+': Flags bits are: '+bits);π writeln('Drive '+Drive+': Flags bits are: '+bits);π writeln(f,'Drive '+Drive+': AX+carry+parity is: ',ax+(flags AND fCarry)+(flags AND fParity));π writeln('Drive '+Drive+': AX+carry+parity is: ',Dtype);ππ writeln(f,'Drive '+Drive+': flags AND fCarry is: ',flags AND fCarry,' ',flags AND fCarry = fCarry);π writeln('Drive '+Drive+': flags AND fCarry is: ',flags AND fCarry,' ',flags AND fCarry = fCarry);π writeln(f,'Drive '+Drive+': flags AND fParity is: ',flags AND fParity,' ',flags AND fParity = fParity);π writeln('Drive '+Drive+': flags AND fParity is: ',flags AND fParity,' ',flags AND fParity = fParity);π writeln(f,'Drive '+Drive+': flags AND fAuxiliary is: ',flags AND fAuxiliary,' ',flags AND fAuxiliary = fAuxiliary);π writeln('Drive '+Drive+': flags AND fAuxiliary is: ',flags AND fAuxiliary,' ',flags AND fAuxiliary = fAuxiliary);π writeln(f,'Drive '+Drive+': flags AND fZero is: ',flags AND fZero,' ',flags AND fZero = fZero);π writeln('Drive '+Drive+': flags AND fZero is: ',flags AND fZero,' ',flags AND fZero = fZero);π writeln(f,'Drive '+Drive+': flags AND fSign is: ',flags AND fSign,' ',flags AND fSign = fSign);π writeln('Drive '+Drive+': flags AND fSign is: ',flags AND fSign,' ',flags AND fSign = fSign);π writeln(f,'Drive '+Drive+': flags AND fOverFlow is: ',flags AND fOverflow,' ',flags AND fOverFlow = fOverFlow);π writeln('Drive '+Drive+': flags AND fOverFlow is: ',flags AND fOverflow,' ',flags AND fOverFlow = fOverFlow);ππ if (Dtype > 0) then if DriveIsRemote(Drive)π then writeln(f,' ***** This drive is remote (network) or Substituted ? Yes/No/Which *****');ππ writeln(f,' ***** This is a '+DriveTypes[DriveType(f,Drive)]+' ? Yes/No *****');π writeln(f);π writeln;π end; (* Drive is valid *)π end; (* For loop *)π end; (* Lastdrive detection *)π writeln(f,'End of Report... and Thanks for running this test !');π close(f); {$I+}π if IoResult <> 0 then;ππ writeln('Please print out and mail in the TESTDISK.RPT file.');π writeln('You''ll find it in this sub-directory.');π writeln('Thanks for running this test !');πEnd. 73 08-24-9413:27ALL PAUL WEST CD-ROM Dectection SWAG9408 v6D@ 51 ╣ {π JM>Would you happen to have any example code to determine if a drive is aπ JM>hard disk, cd-rom, ramdrive etc. ?ππHere is a unit that will at least tell you a little about the CD-ROM. Not allπMSCDEX functions are implemented, but enough to identify the CD-ROMS.π}πunit CDROM;ππ{$X+} { Extended Syntax Rules }ππinterfaceππtypeπ CDR_DL_ENTRY = recordπ UNITNO : byte;π OFFSET : word;π SEGMENT : word;π end;ππ CDR_DL_BUFFER = array[1..26] of CDR_DL_ENTRY;π CDR_DRIVE_UNITS = array[0..25] of byte;π CDR_VTOC = array[1..2048] of byte;ππ{ 00h } procedure CDR_GET_DRIVE_COUNT (var COUNT, FIRST: word);π{ 01h } procedure CDR_GET_DRIVE_LIST (var LIST: CDR_DL_BUFFER);π{ 02h } function CDR_GET_COPR_NAME (DRIVE: byte): string;π{ 03h } function CDR_GET_ABSTRACT_NAME (DRIVE: byte): string;π{ 04h } function CDR_GET_BIBLIO_NAME (DRIVE: byte): string;π{ 05h Read VTOC }π{ 06h Reserved }π{ 07h Reserved }π{ 08h Absolute Disk Read }π{ 09h Absolute Disk Write }π{ 0ah Reserved }π{ 0bh } function CDR_DRIVE_CHECK (DRIVE: byte): boolean;π{ 0ch } function CDR_VERSION: word;π{ 0dh } procedure CDR_GET_DRIVE_UNITS (var BUFFER: CDR_DRIVE_UNITS);π{ 0eh Get or Set VDR }π{ 0fh Get Dir Entry }π{ 10h Send Device Request }ππimplementationππuses dos, strings;ππconstπ CDROM_INTERRUPT = $2f;ππvarπ REG : registers;ππprocedure CDR_GET_DRIVE_COUNT (var COUNT, FIRST: word);πassembler;ππ{ Returns the total number of CD-ROM Drives in the system }π{ and the logical drive number of the first drive. }ππ{ In a system that contains multiple CD-ROM Drives and is }π{ also networked, the CD-ROM drives might not be assigned }π{ as consecutive logical units. See also MSCDEX Function }π{ 0Dh (Get CD-ROM Drive Letters) }ππasmπ mov ax, 1500hπ xor bx, bxπ int CDROM_INTERRUPTπ les di, COUNTπ mov es:[di], bxπ les di, FIRSTπ mov es:[di], cxπend;ππprocedure CDR_GET_DRIVE_LIST (var LIST: CDR_DL_BUFFER);πassembler;ππ{ Returns a driver unit identifier for each CD-ROM drive }π{ in the system, along with the address of the header for }π{ the device driver that controls the drive. }ππ{ The driver unit code returned in the buffer is not the }π{ systemwide logical drive identifier but is the relative }π{ unit for that particular driver. For example if three }π{ CD-ROM drivers are installed, each supporting one phy- }π{ sical drive, the driver unit code in each 5 byte entry }π{ will be 0. The systemwide drive identifiers for each }π{ CD-ROM unit can be obtained with MSCDEX Function 0Dh }π{ (Get CD-ROM Drive Letters). }ππasmπ mov ax, 1501hπ les bx, LISTπ int CDROM_INTERRUPTπend;ππfunction CDR_GET_COPR_NAME (DRIVE: byte): string;ππ{ Returns the name of the copyright file from the volume }π{ table of contents (VTOC) of the specified CD-ROM Drive. }ππ{ CD-ROM Specs allow for a 31 character filename followed }π{ by a semicolon (;) and a 5 digit version number. }ππ{ On disks that comply with the High Sierra standard, }π{ the filename has an MS-DOS compatable (8/3) format. }ππvarπ BUFFER : array[0..38] of char;ππbeginπ REG.AX := $1502;π REG.CX := DRIVE;π REG.ES := seg(BUFFER);π REG.BX := ofs(BUFFER);π intr(CDROM_INTERRUPT, REG);π CDR_GET_COPR_NAME := strpas(BUFFER);πend;ππfunction CDR_GET_ABSTRACT_NAME (DRIVE: byte): string;ππ{ Returns the name of the abstract file from the volume }π{ table of contents (VTOC) for the specified CD-ROM drive.}ππ{ CD-ROM Specs allow for a 31 character filename followed }π{ by a semicolon (;) and a 5 digit version number. }ππ{ On disks that comply with the High Sierra standard, }π{ the filename has an MS-DOS compatable (8/3) format. }ππvarπ BUFFER : array[0..38] of char;ππbeginπ REG.AX := $1503;π REG.CX := DRIVE;π REG.ES := seg(BUFFER);π REG.BX := ofs(BUFFER);π intr(CDROM_INTERRUPT, REG);π CDR_GET_ABSTRACT_NAME := strpas(BUFFER);πend;ππfunction CDR_GET_BIBLIO_NAME (DRIVE: byte): string;ππ{ Returns the name if the bibliographic file from the }π{ volume table of contents (VTOC) for the specified drive.}ππ{ CD-ROM Specs allow for a 31 character filename followed }π{ by a semicolon (;) and a 5 digit version number. }ππ{ This function is provided for compatability with the }π{ ISO-9660 standard. A null string is returned for disks }π{ complying with the High Sierra standard. }ππvarπ BUFFER : array[0..38] of char;ππbeginπ REG.AX := $1504;π REG.CX := DRIVE;π REG.ES := seg(BUFFER);π REG.BX := ofs(BUFFER);π intr(CDROM_INTERRUPT, REG);π CDR_GET_BIBLIO_NAME := strpas(BUFFER);πend;ππfunction CDR_DRIVE_CHECK (DRIVE: byte): boolean;ππ{ Returns a code indicating whether a particular logical }π{ unit is supported by the Microsoft CD-ROM Extensions }π{ module (MSCDEX). }ππbeginπ REG.AX := $150b;π REG.BX := $0000;π REG.CX := DRIVE;π intr(CDROM_INTERRUPT, REG);π CDR_DRIVE_CHECK := (REG.AX <> $0000) and (REG.BX = $adad);πend;ππfunction CDR_VERSION: word;ππ{ Returns the version number of the Microsoft CD-ROM Extensions }ππ{ The Major Version number is returned in the High Order byte }π{ and the Minor Version Number is returned in the Lo order }π{ byte. IE if the MSCDEX Version is 2.10, this routine will }π{ return $0210. }ππbeginπ REG.AX := $150c;π REG.BX := $0000;π intr(CDROM_INTERRUPT, REG);ππ { Version 1.0 Returns 0 instead of actual Version Number }π { So we will fix it so that this routine returns 1.0 }ππ if REG.BX = 0 then beginπ CDR_VERSION := $0100;π end else beginπ CDR_VERSION := REG.BX;π end;πend;ππprocedure CDR_GET_DRIVE_UNITS(var BUFFER: CDR_DRIVE_UNITS);πassembler;ππ{ Returns a list of the systemwide logical drive identifers }π{ that are assigned to CD-ROM drives. }ππ{ Upon return the buffer contains a series of 1 byte entries. }π{ Each entry is a logical unit code assigned to a CD-ROM drive }π{ (0 = A, 1 = B, etc); the units might not be consecutive. }ππ{ The number of valid entries can be determined by MSCDEX }π{ function 00h. }ππasmπ mov ax, 150dhπ les bx, BUFFERπ int CDROM_INTERRUPTπend;ππend.π 74 08-24-9413:28ALL OLAF GREIS CD-ROM Detection SWAG9408 LDPα 6 ╣ {πQ: How do I detect, a certain drive is a CD-Rom?ππA: The foolowing function returns True if the drive is a CD-ROM.π}ππ Uses DOS;π FUNCTION Is_CDROM(Drv : Char):BOOLEAN;π VAR R : Registers;π CDR: string;π cnt: byte;π BEGINπ Is_CDROM := false;π CDR := '';π WITH R DOπ BEGINπ AX := $1500;π BX := $0000;π CX := $0000;π Intr( $2F, R );π IF BX > 0 THENπ BEGINπ FOR cnt := 0 TO (bx-1) DOπ CDR := CDR +CHAR( CL + Byte('A') + cnt );π END;π Is_CDROM := POS( upcase(Drv), CDR ) > 0π ENDπ END;π 75 08-24-9413:30ALL TURBO POWER DPMI Read/Write Sectors SWAG9408 ▀╙uv 53 ╣ {$S-,R-,V-,I-,B-,F+,O+,A-,X+}ππunit DDisk;π {-Read and write absolute sectors using DOS int $25 and $26π in protected mode under DOS or Windows. Does not support real mode.π Requires BP7 or TPW 1.5.ππ Based on the code in the OPDOS unit from Object Professional.ππ Thanks to Maynard Riley and Mark Boler for work done on this unit.ππ Notes:π The calling parameters correspond to those in OPDOS.π Drive = 0 corresponds to drive A.π Sectors are typically 512 bytes each. NumSects*SectorSize must beπ less than 64K.π Buf may be any buffer in a protected mode program. DDISKπ temporarily allocates a DOS real mode buffer, then copiesπ the result into or out of Buf.π If the function returns False, the DosError variable from theπ DOS or WINDOS unit may have a non-zero value with more informationπ about the failure.ππ Use DPMIWriteDiskSectors with caution!ππ Version 1.0 (first public release) 7/19/94ππ For more information, contact TurboPower Softwareπ CompuServe 76004,2611π }ππinterfaceππfunction DPMIReadDiskSectors(Drive : Word;π FirstSect : LongInt; NumSects : Word;π var Buf) : Boolean;π {-Read sectors using int $25}ππfunction DPMIWriteDiskSectors(Drive : Word;π FirstSect : LongInt; NumSects : Word;π var Buf) : Boolean;π {-Write sectors using int $26}ππ {====================================================================}ππimplementationππusesπ{$IFDEF DPMI}π DOS,π{$ELSE}π WinDOS,π{$ENDIF}π WinAPI;ππtypeπ DpmiRealBuf =π objectππ privateπ Bytes : LongInt;π BufBase : LongInt;ππ publicπ constructor Init(BufBytes : LongInt);π destructor Done;π function Size : LongInt;π function Segment : Word;π function Selector : Word;π function RealPtr : Pointer;π function ProtPtr : Pointer;π end;ππ DPMIRegisters =π recordπ DI : LongInt;π SI : LongInt;π BP : LongInt;π Reserved : LongInt;π BX : LongInt;π DX : LongInt;π CX : LongInt;π AX : LongInt;π Flags : Word;π ES : Word;π DS : Word;π FS : Word;π GS : Word;π IP : Word;π CS : Word;π SP : Word;π SS : Word;π end;ππ PacketPtr = ^PacketRec;π PacketRec =π recordπ StartLo : Word;π StartHi : Word;π Count : Word;π BufOfs : Word;π BufSeg : Word;π end;ππ procedure GetRealModeIntVector(IntNo : Byte; var Vector : Pointer); assembler;π asmπ mov ax,0200hπ mov bl,IntNoπ int 31hπ les di,Vectorπ mov word ptr es:[di],dxπ mov word ptr es:[di+2],cxπ end;ππ function CallFarRealModeProc(var Regs : DPMIRegisters) : Word; assembler;π asmπ mov ax,0301hπ xor bx,bxπ xor cx,cxπ les di,Regsπ int 31hπ jc @@9π xor ax,axπ@@9:π end;ππ function DpmiRealBuf.Segment : Word;π beginπ Segment := BufBase shr 16;π end;ππ function DpmiRealBuf.Selector : Word;π beginπ Selector := BufBase and $FFFF;π end;ππ function DpmiRealBuf.RealPtr : Pointer;π beginπ RealPtr := Ptr(BufBase shr 16, 0);π end;ππ function DpmiRealBuf.ProtPtr : Pointer;π beginπ ProtPtr := Ptr(BufBase and $FFFF, 0);π end;ππ function DpmiRealBuf.Size : LongInt;π beginπ Size := Bytes;π end;ππ constructor DpmiRealBuf.Init(BufBytes : LongInt);π beginπ BufBase := GlobalDosAlloc(BufBytes);π if BufBase = 0 thenπ Fail;π Bytes := BufBytes;π end;ππ destructor DpmiRealBuf.Done;π beginπ GlobalDosFree(Selector);π end;ππtypeπ DiskInfoRec =π objectπ DriveNumber : Byte;π ClustersAvailable : Word;π TotalClusters : Word;π BytesPerSector : Word;π SectorsPerCluster : Word;π constructor Init(d : Byte);π end;ππ constructor DiskInfoRec.Init(d : Byte);π varπ Ok : Boolean;π beginπ DriveNumber := d; { 0 = default ; 1 = 'A' }ππ asmπ mov dl,dπ mov ah,$36π int $21π cmp ax,$FFFFπ je @8ππ les di,Selfπ mov es:[di].SectorsPerCluster,axπ mov es:[di].ClustersAvailable,bxπ mov es:[di].BytesPerSector,cxπ mov es:[di].TotalClusters,dxπ mov al,Trueπ jmp @9ππ@8: mov al,Falseπ@9: mov Ok,alπ end;ππ if not Ok thenπ Fail;π end;ππ function DPMIReadWrite(Drive : Word;π FirstSect : LongInt; NumSects : Word;π var Buf; Vector : Byte) : Boolean;π varπ SaveInt : Pointer;π Status : Word;π BufBytes : LongInt;π DiskInfo : DiskInfoRec;π InterimBuf : DpmiRealBuf;π PacketBuf : DpmiRealBuf;π Regs : DPMIRegisters;π beginπ DosError := 0;π DPMIReadWrite := False;ππ if not DiskInfo.Init(Drive+1) thenπ Exit;ππ BufBytes := LongInt(NumSects)*DiskInfo.BytesPerSector;π if BufBytes > 65535 thenπ Exit;π if not InterimBuf.Init(BufBytes) thenπ Exit;ππ if not PacketBuf.Init(SizeOf(PacketRec)) then beginπ InterimBuf.Done;π Exit;π end;ππ if Vector = $26 thenπ Move(Buf, InterimBuf.ProtPtr^, BufBytes);ππ FillChar(Regs, SizeOf(Regs), 0);π with PacketPtr(PacketBuf.ProtPtr)^ do beginπ StartLo := FirstSect and $FFFF;π StartHi := FirstSect shr 16;π Count := NumSects;π BufOfs := 0;π BufSeg := InterimBuf.Segment;π end;ππ GetRealModeIntVector(Vector, SaveInt); { returns real mode seg:ofs }π with Regs do beginπ CX := $FFFF;π AX := Drive;π BX := 0;π DS := PacketBuf.Segment;π CS := LongInt(SaveInt) shr 16;π IP := LongInt(SaveInt) and $FFFF;π end;π Status := CallFarRealModeProc(Regs);ππ if Status = 0 thenπ if Odd(Regs.Flags) thenπ DosError := Regs.AXπ else beginπ if Vector = $25 thenπ Move(InterimBuf.ProtPtr^, Buf, BufBytes);π DPMIReadWrite := True;π end;ππ PacketBuf.Done;π InterimBuf.Done;π end;ππ function DPMIReadDiskSectors(Drive : Word;π FirstSect : LongInt; NumSects : Word;π var Buf) : Boolean;π beginπ DPMIReadDiskSectors := DPMIReadWrite(Drive, FirstSect, NumSects, Buf, $25);π end;ππ function DPMIWriteDiskSectors(Drive : Word;π FirstSect : LongInt; NumSects : Word;π var Buf) : Boolean;π beginπ DPMIWriteDiskSectors := DPMIReadWrite(Drive, FirstSect, NumSects, Buf, $26);π end;ππend.π 76 08-24-9413:31ALL MAYNARD PHILBROOK Disk-detecting routine SWAG9408 ≈╩vÿ 6 ╣ {π -=> Quoting Christian Proehl to All <=-ππ CP> Subject: Disk-detecting routines without DOS (andππ CP> Muelheim, den 20.05.94ππ CP> Hello!ππ CP> I have problem I don't know how to solve it.π CP> Perhaps someone around the world knows more, please help me!ππ use the bios callππ function $16, int $13π}ππfunction DiskChange( DriveNmber :Byte) :Boolean;πBeginπ ASmπ Mov AH, $16π Mov DL, driveNmberπ Int $13π Mov AL,AH; { use AL & AH as a Return Value }π End;πEnd;ππBeginπ If DiskChange(0) then Write(' Disk has Changed in Drive ''A'' ')π Elseπ Write(' Disk Has changed ');πend.π 77 08-24-9413:32ALL ANDREW EIGUS Drive Detection SWAG9408 ?╚ û 11 ╣ {π SA> Does anyone have any idea of how I can check the system hardware andπ SA> identify available hard drives and disk drives?π}ππππconstπ { GetDriveType return values. REQUIRES DOS 3.x or greater}ππ dtError = 0; { Drive physically isn't available }π dtRemote = 1; { Remote (network) disk drive }π dtFixed = 2; { Fixed (hard) disk drive }π dtRemovable = 3; { Removable (floppy) disk drive }π dtBadVer = $FF; { Invalid DOS version (DOS 3.x required) }πππFunction GetDriveType(Drive : byte) : byte; assembler;πAsmπ MOV AH,30hπ INT 21hπ CMP AL,3π JGE @@1π MOV AL,dtBadVerπ JMP @@4π@@1:π MOV BL,Driveπ MOV AX,4409hπ INT 21hπ JNC @@2π MOV AL,dtErrorπ JMP @@5π@@2:π CMP AL,Trueπ JNE @@3π MOV AL,dtRemoteπ JMP @@5π@@3:π MOV AX,4408hπ INT 21hπ CMP AL,Trueπ JNE @@4π MOV AL,dtFixedπ JMP @@5π@@4:π MOV AL,dtRemovableπ@@5:πEnd; { GetDriveType }ππvarπ Drive : byte;π DT : byte;ππBeginπ for Drive := 1 to 25 doπ beginπ DT := GetDriveType(Drive);π if DT <> dtError thenπ beginπ Write('Drive ', Chr(Drive + 64), ': ');π case DT ofπ dtRemote: WriteLn('Network drive');π dtFixed: WriteLn('Hard disk');π dtRemovable: WriteLn('Floppy drive')π endπ endπ endπEnd.ππ 78 08-24-9417:52ALL BJÖRN FELTEN TRUENAME (BASM) SWAG9408 ∞E ò 10 ╣ {SWAG=DOS.SWG,BJÖRN FELTEN,TRUENAME (BASM)}ππ{ Updated DOS.SWG on August 24, 1994 }ππππprogram TName; { to test the TrueName function }ππfunction TrueName(var P: string): string; assembler;π{ returns TrueName just like the DOS command does }π{ if error, returns a zero length string }π{ will probably crash for DOS versions < 3.0 }π{ donated to the Public Domain by Björn Felten @ 2:203/208 }πasmπ push dsπ lds si,Pπ@strip:π inc si { skip length byte ... }π cmp byte ptr [si],' 'π jle @strip { ... and trailing white space }ππ les di,@Resultπ inc di { leave room for byte count }π mov ah,60h { undocumented DOS call }π int 21hπ pop dsπ jc @errorππ mov cx,80 { convert ASCIZ to Pascal string }π xor ax,axπ repnz scasb { find trailing zero }π mov ax,80π sub ax,cx { get length byte }π jmp @retππ@error:π xor ax,ax { return zero length string }ππ@ret:π les di,@Resultπ stosbπend;πππvar S:string;πbeginπ S:=paramstr(1);π if paramcount<>1 thenπ writeln('Usage: tname <filename>')π elseπ writeln('TrueName of ',S,' is ',TrueName(S))πend.π 79 08-24-9417:53ALL VARIOUS TrueName equivalent SWAG9408 u╧ 20 ╣ π{ This program uses a proc from my pascal library that I use to getπ true names. Written and tested with tp4 should work with any tp andπ dos 3.1+ gm 05/94 }πusesπ dos;π {--05/93 gary a. mays --}π { this procedure uses the undocumented dos function $60 to fetch theπ canonical name of a file or path specification }π procedure canonicalize(path: string; var canonical: string;π var stat: word);π varπ regs : registers;π i : integer;π bytes : byte absolute canonical;π beginπ with regs doπ beginπ stat := 0;π ah := $60;π path := path + chr(0); { convert to asciz }π ds := seg(path[1]); { asciz name }π si := ofs(path[1]);π es := seg(canonical[1]);{ points to 128 byte result buffer }π di := ofs(canonical[1]);{ result is asciz }π msdos(regs); { returns canonical name: does not have to exist... }π if flags and fcarry > 0 thenπ stat := axπ elseπ beginπ bytes := 0;π while canonical[bytes + 1] <> #0 do inc(bytes); {conv to ascii}π { not tested on a network - this test will fail on net drive }π if canonical[2] <> ':' then { bad because of bad path }π stat := 3;π end;π end;π end; {canonicalize}ππ varπ stat : word;π path : string;π canonical : string;πbeginπ if paramstr(1) = '' thenπ path := '.'π elseπ path := paramstr(1);π canonicalize(path, canonical, stat);π case stat ofπ 0: writeln(canonical);π 2: writeln('Invalid path: ',path);π 3: writeln('Invalid drive or malformed path: ',path);π else writeln('Status: ',stat,' for ',path);π end; {case}πend.πππIL> I'm looking for an equivalent to the DOS command TRUENAME. Here's anππprogram TruePath;πuses OpString,DOS;πvarπ OldName, NewName : String;π RegisterSet : Registers;πBeginπ OldName:=ParamStr(1);π OldName[Length(OldName)+1] := #0;π NewName[0] := #0;π With RegisterSet doπ Beginπ AH := $60;π AL := 0;π DS := Seg(OldName[1]);π SI := Ofs(OldName[1]);π ES := Seg(NewName[1]);π DI := Ofs(NewName[1]);π End;π MsDos(RegisterSet);π If Odd(RegisterSet.Flags) Thenπ Writeln('Failure ',RegisterSet.AX) (* failure code *)π Elseπ Beginπ NewName[0]:=#255;π NewName[0]:=Chr(Pos(#0,NewName));π Writeln(NewName);π End;πEnd.π 80 08-25-9409:06ALL MARTIN RICHARDSON Getting Disk Type SWAG9408 Iⁿû 12 ╣ {πMR│ How do you tell the difference between a fixed hard drive, and aπ │ removable drive or network drive? Why? I have a program which reportsππThis little demo program contains the answers for most of yourπquestions.πππ{ uses int $21, service $44, subservices 8 & 9 to get driveπ existence, removeable/non-removeable, and local/remote status }ππuses dos;ππvar drive : word;π ts : string[30];π r : registers;π drexist : boolean;ππbeginπ for drive := 1 to 26 doπ beginπ drexist := false;π ts := 'unkn';ππ r.ax := $4408; { check for dos floppy/hard drv }π r.bl := drive;π msdos(r);π if not odd(r.flags) then { if not carry then ... }π beginπ drexist := true;π if (r.ax = 0) then ts := 'floppy' else ts := 'hard';π end;ππ r.ax := $4409; { check for local/remote (lan) drv }π r.bl := drive;π msdos(r);π if not odd(r.flags) thenπ beginπ drexist := true;π if ((r.dh and $10) <> 0) then ts := 'remote';π end;ππ If DrExist thenπ beginπ ts := chr(ord('A')+pred(drive))+': ' + ts;π writeln(ts);π end;π end;πend.π 81 08-25-9409:11ALL GREG VIGNEAULT VOLUME LABEL Program SWAG9408 TΣ≥▀ 26 ╣ {π>Can someone please tell me how to read the volume label off a hardπ>disk or floppy. I haven't been able to find any information on howπ>to do this. Thanks for any help you can offer.ππ Here's one way, which is valid for DOS 3.0 or higher...ππ}πPROGRAM VOLAB; { Read a disk volume label (TP4+) }π { June 12, 1994. Greg Vigneault }πUSES Dos; { import MsDos, Registers }πTYPE ASCIIZ = ARRAY [0..255] OF CHAR; { ASCIIZ strings }πCONST TAB = #9; { ASCII horizontal tab }πVAR Drv : CHAR; { drive letter 'A'..'Z' }π Volume : STRING; { for volume label }π Reg : Registers; { to access CPU registers }ππPROCEDURE Asciiz2TP (AStr:ASCIIZ; VAR Temp:STRING);π { convert an ASCIIZ (DOS) string to a TP string }π VAR Index:BYTE; BEGIN Index := 0;π WHILE (Index < 255) AND (AStr[Index] <> #0) DO BEGINπ Temp[Index+1] := AStr[Index];; INC(Index);π END{WHILE};; Temp[0] := CHR(Index);π END {Asciiz2TP};ππPROCEDURE TP2Asciiz (TStr:STRING; VAR Temp:ASCIIZ);π { convert a TP string to an ASCIIZ (DOS) string }π VAR Index:BYTE; BEGIN Index := ORD(TStr[0]);; Temp[Index] := #0;π WHILE (Index > 0) DO BEGINπ Temp[Index-1] := TStr[Index];; DEC(Index);π END{WHILE};π END {TP2Asciiz};ππFUNCTION GetVolLabel (Drv:CHAR):STRING;π VAR Temp:ASCIIZ; Temp2:STRING; Index:BYTE; seg0,ofs0:WORD;π DTA : ARRAY [0..127] OF CHAR; BEGIN Temp2 := '';π IF Drv IN ['A'..'Z'] THEN BEGIN { valid drive spec? }π Reg.AH := $2F;; MsDos(Reg); { get current DTA address }π seg0 := Reg.ES;; ofs0 := Reg.BX; { save the orig DTA }π Reg.DS := SEG(DTA);; Reg.DX := OFS(DTA); { our local DTA }π Reg.AH := $1A;; MsDos(Reg); { activate our DTA }π Temp2 := '?:\*.*';; Temp2[1] := Drv; { build filespec }π TP2Asciiz (Temp2, Temp); { xlate to ASCIIZ }π Reg.DS := SEG(Temp);; Reg.DX := OFS(Temp);; Reg.CX := 8;π Reg.AH := $4E;; MsDos(Reg); { label search, then reset DTA... }π Reg.DS := seg0;; Reg.DX := ofs0;; Reg.AH := $1A;; MsDos(Reg);π IF NOT ODD(Reg.FLAGS) { no DOS error? }π THEN FOR Index := $1E TO $2A DO Temp[Index-$1E] := DTA[Index]π ELSE Temp[0] := #0; { if no volume label found }π Asciiz2TP(Temp, Temp2); { xlate DOS to TP string }π IF (Length(Temp2) > 8) AND (Temp2[9] = '.') { if 8/3 format }π THEN Delete (Temp2,9,1);π END{IF Drv};π GetVolLabel := Temp2;π END {GetVolLabel};ππBEGIN {VOLAB: here we go...}ππ WriteLn;; WriteLn (TAB,'ReadVOL v0.01 Greg Vigneault');; WriteLn;π REPEATπ Write (TAB,'Read volume label from which drive [A..Z] ? ');π Read (Drv);; Drv := UpCase(Drv);π UNTIL Drv IN ['A'..'Z'];π Volume := GetVolLabel (Drv);; WriteLn;π IF Length(Volume) <> 0π THEN WriteLn (TAB,'Volume in drive ',Drv,': is ', Volume)π ELSE WriteLn (TAB,'No label for volume in drive ',Drv,':');π WriteLn;ππEND {VOLAB}.π 82 08-25-9409:12ALL JOSE CAMPIONE Valid Drives SWAG9408 ±∞WU 12 ╣ πprogram valid_drv;ππuses dos;ππ{ πFunction ready_drives reports as valid only drives that are πready to be read. Findfirst does not cause a critical error even πif a floppy is not ready and in machines with a single floppy πthe prompt to insert a diskette when testing for the B: drive π(from IO.SYS) is avoided by the use of DOS services $4408 and π$440E (requires DOS 3.2 or up). - πJose Campione (1:163/513.3) August 1994 -π} ππfunction ready_drives: string;πvarπ regs : registers;π i : byte;π drs: string;π sr : searchrec;ππ function is_last(d:byte):boolean;π {true if d is the only or the last name assigned to that drive}π beginπ regs.ax:= $440E;π regs.bl:= d;π msdos(regs);π is_last:= ((regs.flags and fcarry) = 0) and ((regs.al = 0) or (regs.al = d));π end;ππ function is_floppy(d: byte): boolean;π {true if d is a removable medium}π beginπ regs.ax:= $4408;π regs.bl:= d;π msdos(regs);π is_floppy := ((regs.flags and fcarry) = 0) and (regs.ax = 0);π end;ππbeginπ drs:= '';π for i:= 1 to 26 do beginπ if (not is_floppy(i)) or is_last(i) then beginπ findfirst(chr(i + 64) + ':\*.*',AnyFile,sr);π if doserror = 0 then drs:= drs + chr(i + 64);π end;π end;π ready_drives:= drs;πend;ππbeginπ writeln('drives ready : ',ready_drives);πend.ππ
