Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/FERRAMEN/VOL_DLL/LABELDLL.PAS

Pascal/Delphi Source File | 1993-07-02 | 5.7 KB | 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.