' *** CAT.GFA *** ' ' A Catalogue Utility by Henrique Veludo (CIS:70210.221 Delphi:HENRIQUE) ' Dim Fn$(3000),Fs%(3000),At$(3000),S_dir$(255),Pt$(3000),Dn$(3000),Tm$(3000),Dt$(3000) Ldrive$=Chr$(Gemdos(25)+65)+":" Sdrive$=Ldrive$ If Xbios(4)=0 Alert 3," | SORRY !| Medium or High| resolution only ! |",1," Oops ! ",A% Edit Endif Old%=False On Error Gosub Error_routine Start: Cls Ln%=0 Last%=False Desc%=False If Not Old% Alert 0,"Catalogue Utility by H. Veludo| CIS Id: 70210,221| Would you like a 'short' | or a 'long' display ?",2,"Long|Short",A% If A%=1 Long%=True Else Long%=False Endif Endif Close #1 Console%=True Open "O",#1,"CON:" @Get_filename @Get_stat @Get_dir If Xq%>0 @Sort_it @Print_it Endif Ln%=23 @Check_lines Alert 0," |Would you like to ADD to this|catalogue or load a NEW one ?| ",3,"Add|New|Continue",B% If B%=2 Xq%=0 Old%=False Goto Start Endif If B%=1 Old%=True Goto Start Endif If B%=3 Alert 0," Would you like to save | this catalogue to DISK| or make a HARDCOPY ?| ",3,"Cancel|Printer|Disk",C% If C%=3 Alert 0," |Would you like to provide some|space for a file description ?| ",2,"No| Yes ",A% If A%=1 Desc%=False Else Desc%=True Endif Console%=False If Xq%>0 Cls Close #1 Print At(20,1);Chr$(27);"pPlease SELECT a name for your catalogue...";Chr$(27);"q"; Fileselect Sdrive$+"\*.*",Ext$+".CAT",File$ If File$="" Xq%=0 Lpth$="" Goto Start Else Sdrive$=Left$(File$,2) Open "O",#1,File$ Endif Print At(1,1);Chr$(27);"l"; Cls @Print_it Close #1 Alert 0,"The line length of the saved|file is longer than 80 chrs.| Please use compressed mode| to print it.",1," OK ",A% Endif Endif If C%=2 Console%=False If Xq%>0 Cls Close #1 Open "O",#1,"LST:" @Print_it Lprint Lprint Endif Endif Endif Alert 0," |Would you like to display or| print another catalogue ?| ",2," NO | YES ",B% If B%=2 Xq%=0 Old%=False Goto Start Endif Edit ' Procedure Error_routine Resume Start Return ' Procedure Print_it Print #1,"FILENAME.EXT SIZE "; If Desc% Print #1," DESCRIPTION "; Endif If Long% Or Console% Print #1," DATE TIME AT "; Endif Print #1,"DISKNAME.EXT PATH" @Check_lines Print #1,"------------ ------ "; If Desc% Print #1,"---------------------------------- "; Endif If Long% Or Console% Print #1,"-------- -------- -- "; Endif If Desc% Print #1,"------------ --------------------------------------" Else Print #1,"------------ -------------------------" Endif @Check_lines For J%=1 To Xq% Print #1,Using "\..........\ ###### ",Sort$(J%),Fs%(Sort%(J%)); If Desc% Print #1," "; Endif If Long% Or Console% Print #1,Using "\......\ ",Dt$(Sort%(J%)); Print #1,Using "\......\ ",Tm$(Sort%(J%)); Print #1,Using "\\ ",At$(Sort%(J%)); Endif Print #1,Using "\..........\ ",Dn$(Sort%(J%)); If Desc% Print #1,Using "\....................................\",Pt$(Sort%(J%))+"*.*" Else Print #1,Pt$(Sort%(J%))+"*.*" Endif @Check_lines Next J% Return ' Procedure Check_lines If Not Last% If Console% Inc Ln% If Ln%=24 Print At(13,25);Chr$(27);"pPress [RETURN] to end, [SPACE] to continue scrolling...";Chr$(27);"q"; Repeat Z$=Inkey$ Until Z$=Chr$(13) Or Z$=" " If Z$=Chr$(13) Last%=True J%=Xq% Else Last%=False Endif Print At(1,25);Chr$(27);"l"; Ln%=0 Endif Endif Endif Return ' Procedure Get_stat Buf$=Space$(45) Df%=Dfree(Instr("ABCDEFGHIJKLMNOP",Left$(Ldrive$,1))) P$=Ldrive$+"*.*"+Chr$(0) Void Gemdos(&H1A,L:(Varptr(Buf$))) Stat%=Gemdos(&H4E,L:Varptr(P$),8) D_name$="????????.???" Ext$="???" If Stat%=0 D_name$=Mid$(Buf$,31,12) While Right$(D_name$)<"0" Or Right$(D_name$)>"_" D_name$=Left$(D_name$,Len(D_name$)-1) Wend Ext$=Right$(D_name$,3) If Len(D_name$)<12 D_name$=D_name$+String$(12-Len(D_name$)," ") Endif Endif Return ' Procedure Get_filename Start3: Cls Print At(16,1);Chr$(27);"pPlease SELECT the DRIVE\PATH\FILENAME to display...";Chr$(27);"q"; Fileselect Ldrive$+"\*.*","",Fn$ If Fn$="" Run Endif Print At(1,1);Chr$(27);"l"; Cls If Instr("ABCDEFGHIJKLMNOP",Left$(Fn$,1)) And Mid$(Fn$,2,1)=":" Ldrive$=Left$(Fn$,2) Else Goto Start3 Endif I%=Len(Fn$) G%=3 L%=Len(Fn$) If Right$(Fn$,1)<>"\" Do G%=Instr(Fn$,"\",I%) Exit If G%<>0 Dec I% Loop Filename$=Mid$(Fn$,G%+1) Path$=Mid$(Fn$,3,L%-Len(Filename$)-2) Else Path$=Mid$(Fn$,3,L%) Filename$="*.*" Endif Return ' Procedure Get_dir S_dir$(1)=Path$ Sdd%=0 !Number of folders F%=0 !Number of files P%=1 !Folder level While P%>0 Buf$=Space$(45) Path$=S_dir$(P%) Fn$=Ldrive$+Path$+Filename$+Chr$(0) Dec P% @Get_first While Stat%=0 @Get_next Wend Wend Return ' Procedure Get_first Void Gemdos(&H1A,L:Varptr(Buf$)) Stat%=Gemdos(&H4E,L:Varptr(Fn$),&H10) If Stat%=0 Gosub Read_buffer Endif Return ' Procedure Get_next Void Gemdos(&H1A,L:Varptr(Buf$)) Stat%=Gemdos(&H4F) If Stat%=0 Gosub Read_buffer Endif Return ' Procedure Read_buffer F$=Mid$(Buf$,31,Instr(31,Buf$,Chr$(0))-31) S%=Lpeek(Varptr(Buf$)+26) A%=Asc(Mid$(Buf$,22,1)) D%=Dpeek(Varptr(Buf$)+24) T%=Dpeek(Varptr(Buf$)+22) If (A% And &H10)<>0 And Left$(F$,1)<>"." Inc P% S_dir$(P%)=Path$+F$+"\" Inc Sdd% Endif If (A% And &H10)=0 If Path$<>Lpth$ Then Lpth$=Path$ Endif Inc F% Inc Xq% Fn$(Xq%)=F$ Fs%(Xq%)=S% T$=Bin$(T%) If Len(T$)<16 T$=String$(16-Len(T$),"0")+T$ Endif Hr$=Str$(Val("&x"+Left$(T$,Len(T$)-11))) If Len(Hr$)<2 Hr$="0"+Hr$ Endif Mn$=Str$(Val("&x"+Mid$(T$,Len(T$)-10,6))) If Len(Mn$)<2 Mn$="0"+Mn$ Endif Sc$=Str$(Val("&x"+Right$(T$,5))*2) If Len(Sc$)<2 Sc$="0"+Sc$ Endif Tm$(Xq%)=Hr$+":"+Mn$+":"+Sc$ D$=Bin$(D%) Yr$=Str$(80+Val("&x"+Left$(D$,Len(D$)-9))) Mo$=Str$(Val("&x"+Mid$(D$,Len(D$)-8,4))) If Len(Mo$)<2 Mo$="0"+Mo$ Endif Dy$=Str$(Val("&x"+Right$(D$,5))) If Len(Dy$)<2 Dy$="0"+Dy$ Endif Dt$(Xq%)=Mo$+"/"+Dy$+"/"+Yr$ If A%=0 At$(Xq%)="RW" Else At$(Xq%)="RO" Endif Pt$(Xq%)=Lpth$ Dn$(Xq%)=D_name$ Endif Return ' Procedure Sort_it ' Arrays To Be Dimensioned For QuickSort Erase Sort$() Erase Sort%() Erase Pq%() Erase Wq%() Dim Sort$(Xq%+20) ! Temporary String Array used By QuickSort Dim Sort%(Xq%+20) ! Index Array Dim Pq%(20),Wq%(20) ! Arrays Used By QuickSort ' ' Copy String Array to be Sorted in Temporary Array ' For I%=1 To Xq% ! Xq% = Number Of Elements In Array Sort%(I%)=I% ! Initialize Index Array Sort$(I%)=Fn$(I%) ! Sort$() = Temporary Sort String ' ! Fn$() = String Array To Be Sorted Next I% ' ' Initialize Quick Sort Variables ' Kq%=1 Pq%(Kq%)=0 ! Start Count Of Array Wq%(Kq%)=Xq% ! End Count Of Array Dq%=0 ! Start Count Of Array Rq%=Xq% ! End Count Of Array ' ' ---------------------------- QUICK SORT ALGORITHM ---------------------------- Point_1: If Rq%-Dq%<9 Goto Point_10 Endif Iq%=Dq% Jq%=Rq% ' ------------------------------------------------------------------------------ Point_2: If Sort$(Iq%)>Sort$(Jq%) Goto Point_5 Endif ' ------------------------------------------------------------------------------ Point_3: Dec Jq% If Jq%>Iq% Goto Point_2 Endif Inc Jq% ' ------------------------------------------------------------------------------ Point_4: Inc Kq% If (Iq%-Dq%)<(Rq%-Jq%) Goto Point_9 Endif Pq%(Kq%)=Dq% Wq%(Kq%)=Iq% Dq%=Jq% Goto Point_1 ' ------------------------------------------------------------------------------ Point_5: Tq$=Sort$(Jq%) Tq%=Sort%(Jq%) Sort$(Jq%)=Sort$(Iq%) Sort%(Jq%)=Sort%(Iq%) Sort$(Iq%)=Tq$ Sort%(Iq%)=Tq% Goto Point_7 ' ------------------------------------------------------------------------------ Point_6: If Sort$(Jq%)Iq% Goto Point_6 Endif Inc Jq% Goto Point_4 ' ------------------------------------------------------------------------------ Point_8: Tq$=Sort$(Jq%) Tq%=Sort%(Jq%) Sort$(Jq%)=Sort$(Iq%) Sort%(Jq%)=Sort%(Iq%) Sort$(Iq%)=Tq$ Sort%(Iq%)=Tq% Goto Point_3 ' ------------------------------------------------------------------------------ Point_9: Pq%(Kq%)=Jq% Wq%(Kq%)=Rq% Rq%=Iq% Goto Point_1 ' ------------------------------------------------------------------------------ Point_10: If (Rq%-Dq%+1)=1 Goto Point_11 Endif For Iq%=Dq%+1 To Rq% For Jq%=Dq% To Iq%-1 Cq%=Iq%-Jq%+Dq%-1 If Sort$(Cq%)