home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_tools
/
vol_dll
/
labeldll.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-07-02
|
6KB
|
212 lines
{
Steve Guimond Compuserve 70253, 502
July 2, 1993
DLL to get and put disk volume labels, as well as other functions unavailable
from visual basic
This dll uses the TPW Unit VolFuncs.Pas, which Pat Ritchey wrote, Thanks Pat
Calling convention from visual basic
All return 0 if successful or 99 if not.
Read_Label will return 0 if there is a label and 99 if there is not a label
Declare Function Set_Label Lib "labeldll.dll" (ByVal Drive%, ByVal NewLabel$) As Integer
Declare Function Read_Label Lib "labeldll.dll" (ByVal Drive%, ByVal Label$) As Integer
Declare Function Del_Label Lib "labeldll.dll" (ByVal Drive%) As Integer
Drive% (0 = Default, 1 = A, 2 = B, etc..)
*******************************************************************************************
Type and function declarations for FindFirstFile and FindNextFile
Put the type declaration in the global module
Type FindDataType
reserved As String * 21
FileAttr As String * 1
FileTime As Long
FileSize As Long
FileName As String * 13
End Type
Declare Function FindFirstFile Lib "d:\programs\labeldll.dll" (ByVal Path$, ByVal Attr%, FindData As FindDataType) As Integer
Declare Function FindNextFile Lib "d:\programs\labeldll.dll" (FindData As FindDataType) As Integer
********************************************************************************************
Type and sub declaration for ConvertDateTime
The InDate& sent to the function is found in the FindDataType record FindDataType.FileTime (above)
you must first use FindFirstFile or FindNextFile to get the date then use ConvertDateTime
to convert the longint to english
Type DateTimeRec
year As Integer
month As Integer
day As Integer
hour As Integer
min As Integer
sec As Integer
End Type
Declare Sub ConvertDateTime Lib "d:\programs\labeldll.dll" (ByVal InDate&, FindDate As DateTimeRec)
********************************************************************************************
Functions to get total space and get free space left on a specified drive
Declare Function GetTotalSpace Lib "labeldll.dll" (ByVal Drive%) As Long
Declare Function GetFreeSpace Lib "labeldll.dll" (ByVal Drive%) As Long
Return -1 if no space else return space in Bytes
********************************************************************************************
}
Library Label1;
Uses volfuncs, WinDos, Strings;
{**************************************************************************}
Function Set_Label(Drive: Byte; P: PChar): Integer; Export;
Var
x, y: Integer;
NewLabel, a: VolString;
HasLabel, B: Boolean;
q: PChar;
Begin
NewLabel := ''; { make sure newlabel is empty }
q := StrNew(P); { make a copy of string sent in, directly modifying
string sent in will result in a GPF }
q := StrUpper(q); { change string to upper case }
NewLabel := StrPas(q); { convert to pascal style string }
StrDispose(q); { get rid of temporary pointer }
HasLabel := GetLabel(Drive, a); { check if a label exists }
If (Not HasLabel) Or DelLabel(Drive) Then { if it has a label or deleting the
label is successful then set label }
B := SetLabel(Drive, NewLabel);
If B = True Then Set_Label := 0 Else Set_Label := 99;
End;
{*****************************************************************************}
Function Del_Label(Drive: Byte): Integer; Export;
Var
HasLabel: Boolean;
a: VolString;
Begin
HasLabel := GetLabel(Drive, a);
If (NOT HasLabel) Or DelLabel(Drive) Then Del_Label := 0 Else Del_Label := 99;
End;
{*****************************************************************************}
Function Read_Label(Drive: Byte; P: PChar):Integer ; Export;
Var
x: Integer;
B: Boolean;
y: VolString;
Begin
If GetLabel(Drive, y) Then
Begin
Read_Label := 0;
For x := 0 to Length(y) - 1 do
Begin
P[x] := y[x + 1];
End;
End
Else
Begin
Read_Label := 99;
For x := 0 To 10 do
P[x] := ' ';
End;
End;
{*****************************************************************************}
Function FindFirstFile(Path: PChar; Attr: Word; Var F: TSearchRec): Integer ; Export;
Begin
F.Name := ' ';
F.Size := 0;
F.Time := 0;
FindFirst(Path, Attr, F);
FindFirstFile := DosError;
End;
{*****************************************************************************}
Function FindNextFile(Var F: TSearchRec): Integer; Export;
Begin
F.Name := ' ';
F.Size := 0;
F.Time := 0;
FindNext(F);
FindNextFile := DosError;
End;
{****************************************************************************}
Function GetTotalSpace(Drive: Byte): LongInt; Export;
Var
v: LongInt;
Begin
v := DiskSize(Drive);
If v = -1 Then GetTotalSpace := -1
Else
GetTotalSpace := v;
End;
{***************************************************************************}
Function GetFreeSpace(Drive: Byte): LongInt; Export;
Var
v: LongInt;
Begin
v := DiskFree(Drive);
If v = -1 Then GetFreeSpace := -1
Else
GetFreeSpace := v;
End;
{**************************************************************************}
Procedure ConvertDateTime(DateTime: LongInt; Var DT: TDateTime); Export;
Begin
UnPackTime(DateTime, DT);
End;
{*************************************************************************}
Exports
Set_Label,
Read_Label,
FindFirstFile,
FindNextFile,
Del_Label,
GetTotalSpace,
GetFreeSpace,
ConvertDateTime;
Begin
End.