It has a bug in the display and some minor bugs in that area but it does do the search correctly, I integrated his code with my display (and that's the problem), otherwise works...
Code:
#Dim All
#Register None
#Include "WIN32API.INC"
#Resource "Where.pbr"
Type MyApp
title As String * 5
ver As String * 4
creator As String * 27
copyrite As String * 19
rights As String * 20
End Type
Global App As MyApp
Declare Function WildMatchFile(ByVal FileName As String, ByVal WildCard As String) As Integer
Declare Function FileDateTime(fd As WIN32_FIND_DATA) As String
Declare Function DrawCC() As Long
Declare Function AppError(ErrType As Long) As Long
Declare Function Xprint(St As String,Lf As Long) As Long
Declare Function HelpMe() As Long
Declare Function NewWindow() As String
Declare Function PadFileString(St As String) As String
Global RedirFl As Long
Global FileNum As Long
Global ErrType As Long
'==============================================================================
Function PbMain () As Long
NewWindow
Local ThisDir As Long
Local SubDir As Long
Local Found As Long
Local f As Asciiz * 256
Local d As Asciiz * 256
Local hDir As Long
Local FindData As WIN32_FIND_DATA
Local Temp As String
Local Tmp As Long
Local k As Long
Local files As Long
Local bytes As Long
Local Period As Long
Local Extention As String
Local Redir As Asciiz * 2
Local DirFileName As Asciiz * 256
Dim cFileHeader(3) As String
Dim App As MyApp
app.creator = "Computer Creations Software"
app.ver = "v2.2"
app.title = "Where"
app.copyrite = "Copyright (c) 1998"
app.rights = "All rights reserved."
Dim dirs(1 To 500) As String
Dirs(1) = Left$(CurDir$,3)
d = Parse$(Command$,1)
Redir = Parse$(Command$,2)
If Len(d)=0 Or Instr(d,"?") Then
Helpme
Exit Function
End If
If Left$(Redir,1) = ">" Then
RedirFl = 1
DirFileName = Parse$(Command$,3)
End If
cFileHeader(1) = App.Title + " " + App.copyrite + " " + App.creator
cFileHeader(2) = "Filename Size Date Time Drive:Path"
cFileHeader(3) = "------------- ------ ------- ------- ---------------------"
If RedirFl = 1 Then
Filenum = FreeFile
Open DirFileName For Output As #Filenum
End If
For Filenum = 1 To 3
If FileNum = 1 Then
Color 15,0
ElseIf FileNum = 2 Then
Color 11,0
ElseIf FileNum = 3 Then
Color 9,0
End If
Xprint cFileHeader(Filenum),1
Next
Color 7,0
Do
SubDir = 1
Found = 0
FindData.dwFileAttributes = %FILE_ATTRIBUTE_DIRECTORY
f = Dirs(1) + "*.*"
hDir = FindFirstFile(f, FindData)
If hDir = %INVALID_HANDLE_VALUE Then
Exit Do
End If
Do
If WildMatchFile(FindData.cFilename, d) Then
If IsFalse(Found) Then Found = -1
Xprint PadFileString(Left$(FindData.cFilename,12)),0
Xprint Format$(FindData.nFileSizeLow,"###,###,###") + "kb " + FileDateTime(FindData) + " " + Dirs(1),1
Incr files
bytes = bytes + FindData.nFileSizeLow
End If
If (FindData.dwFileAttributes And %FILE_ATTRIBUTE_DIRECTORY) Then
If Asc(FindData.cFilename) <> 46 Then
Incr SubDir
Array Insert Dirs(SubDir), Dirs(1) + FindData.cFilename + "\"
End If
End If
k = Asc(InKey$)
If (k = 3) Or (k = 27) Then
GoTo Done
End If
Loop While FindNextFile(hDir, FindData)
FindClose hDir
Array Delete Dirs(1) For 498
Loop While Len(Dirs(1))
Done:
Xprint "",1
Xprint Format$(files,",")+" files found",1
Xprint Format$(bytes,",")+" total bytes",1
If RedirFl = 1 Then Close FileNum
End Function
'------------------------------------------------------------------------------------------
Function WildMatchFile(ByVal FileName As String, ByVal WildCard As String) As Integer
Local FilePos As Integer
Local WildPos As Integer
Local FileByte As Integer
Local WildByte As Integer
'-- "*.*" matches everything --------
If WildCard = "*.*" Then
WildMatchFile = -1
HelpMe
Exit Function
End If
'-- Convert strings to upper case
FileName = UCase$(FileName)
WildCard = UCase$(WildCard)
FilePos = 1
WildPos = 1
Do
'-- Get one byte from each string
FileByte = Asc(FileName, FilePos)
WildByte = Asc(WildCard, WildPos)
'-- End of wildcard? See if we have a match
If WildPos > Len(WildCard) Then
WildMatchFile = (FilePos >= Len(FileName))
Exit Function
' --- End of filename? No match
ElseIf FilePos > Len(FileName) Then
WildMatchFile = 0
Exit Function
'-- Do bytes match? Or is WildByte a question mark?
ElseIf (WildByte = FileByte) Or (WildByte = 63) Then
Incr WildPos
Incr FilePos
'-- Is WildByte an asterisk? (matches everything)
ElseIf (WildByte = 42) Then
'-- Skip to period or end of filename
While (FileByte<>32) And (FileByte<>46) And (FilePos < Len(FileName))
Incr FilePos
FileByte = Asc(FileName, FilePos)
Wend
Incr WildPos
'-- No match, so exit
Else
WildMatchFile = 0
Exit Function
End If
Loop
End Function
'============================================================================
Function FileDateTime(fd As WIN32_FIND_DATA) As String
Local fh As Long
Local zText As Asciiz * 256
Local st As SYSTEMTIME
Local Temp As String
' -- Convert the file time from UTC to local time
FileTimeToLocalFileTime fd.ftLastWriteTime, fd.ftLastWriteTime
' -- Convert the file time into a compatible system time
FileTimeToSystemTime fd.ftLastWriteTime, st
' -- Create a date string using the local settings
GetDateFormat %LOCALE_USER_DEFAULT, %NULL, st, "MM/dd/yy", zText, 256
Temp = zText
' -- Create a time string using the local settings
GetTimeFormat %LOCALE_USER_DEFAULT, %TIME_NOSECONDS, st, "hh:mm tt", zText, 256
' -- Return the file date and time
Function = Temp + " " + zText
End Function
'------------------------------------------------------------------------------------------
Function DrawCC() As Long
Page 1,2
Local X As Integer
Local Y As Integer
Color 9,0
'1st row of "C1"
Print String$(5,32)+Chr$(220)+ Chr$(219)+ Chr$(223)+ Chr$(220)+ Chr$(219)
'2nd row of "C1"
Print String$(4,32)+Chr$(222)+Chr$(219)+Chr$(221)+String$(2,32)+Chr$(219)
'3rd row of "C1"
Print String$(4,32)+String$(2,219)+String$(3,32);
Color 11,0
'1st row of "C2"
Print Chr$(220)+ Chr$(219)+ Chr$(223)+ Chr$(220)+ Chr$(219)
'4th row of "C1"
Color 9,0
Print String$(4,32)+Chr$(222)+Chr$(219)+Chr$(221)+Chr$(32);
Color 11,0
'2nd row of "C2"
Print Chr$(222)+Chr$(219)+Chr$(221)+String$(2,32)+Chr$(219)
'5th row of "C1"
Color 9,0
Print String$(5,32)+Chr$(223)+Chr$(219)+Chr$(220);
'3rd row of "C2"
Color 11,0
Print String$(2,219)+String$(3,32);
Color 9,0:Print 'Left$(App.Creator,8)
'4th row of "C2"
Color 11,0
Print String$(8,32)+Chr$(222)+Chr$(219)+Chr$(221)+String$(3,32);
Color 9,0
Print " " + App.creator
Color 11,0
'5th row of "C2"
Print String$(9,32)+Chr$(223)+Chr$(219)+Chr$(220)+Chr$(220)+Chr$(223);
Color 14,0: Print" " + App.title + " " + App.Ver + " 32 bit"
Y=CursorX
X=CursorY
If Y < 25 Then Locate X,17 Else Print:Locate X,17
Color 11,0
Print app.copyrite;
Print " " + app.rights
If Y < 25 Then Locate X + 1,17 Else Print:Locate X + 1,17
Color 15,0:Print "http://www.tngbbs.com"
Color 7,0
Page 1,1
End Function
'------------------------------------------------------------------------------------------
Function Xprint(St As String,Lf As Long) As Long
On Error GoTo XprintErr
If RedirFl = 1 Then
Print #Filenum,St;
If Lf > 0 Then Print #FileNum, ""
Else
stdout St;
If Lf > 0 Then StdOut ""
End If
Function = 1
Exit Function
XprintErr:
ErrType = Err
AppError ErrType
Function = 0
End Function
Function AppError(ErrType As Long) As Long
Dim Er(100) As Asciiz * 50
Er(0)= "No Error
Er(5)= "Illegal Function Call
Er(7)= "Out of memory
Er(9)= "Subscript / Pointer Out of range
Er(51)= "Internal Error
Er(52)= "Bad file Name Or number
Er(53)= "File Not found
Er(54)= "Bad file mode
Er(55)= "File is already Open
Er(57)= "Device I/O Error
Er(58)= "File already exists
Er(61)= "Disk full
Er(62)= "Input past End
Er(63)= "Bad record number
Er(64)= "Bad file Name
Er(67)= "Too many files
Er(68)= "Device unavailable
Er(70)= "Permission denied
Er(71)= "Disk Not ready
Er(72)= "Disk media Error
Er(74)= "Rename across disks
Er(75)= "Path/file access Error
Er(76)= "Path Not found"
Print "Error: " + Ltrim$(Str$(ErrType))
End Function
'------------------------------------------------------------------------------------------
Function HelpMe() As Long
Local I As Asciiz * 2
Drawcc
Color 7,0
StdOut
StdOut "Useage: Where <filename.ext> <options>"
StdOut " Where <filename.ext> can be any combination of wildcards"
StdOut " Where *.*, Where *.txt Where Myfile.*"
StdOut "Options:"
StdOut " Where filename.ext > yourfile.ext --> redirect to a file"
StdOut " Where filename.ext |more --> pause after 24 lines"
StdOut ""
End Function
'------------------------------------------------------------------------------------------
Function NewWindow() As String
Local hWnd As Long
Local TmpAsciiz As Asciiz * %Max_Path
Local y As Long
hWnd = GetForegroundWindow
If GetWindowThreadProcessId(hWnd, GetCurrentProcessId) <> GetCurrentThreadId Then
GetModuleFileName GetModuleHandle(ByVal 0), TmpAsciiz, SizeOf(TmpAsciiz) - 1
FreeConsole
y = Shell (Chr$(34) + TmpAsciiz + Chr$(34, 32) + Command$, 1)
Exit Function
End If
'Console Screen , WindowY
Function = Command$
WaitKey$
End Function
Function PadFileString(St As String) As String
Local l_szSt As String * 14
Function = l_szSt
End Function
Scott
Leave a comment: