Re: Application Logging

LOL!

Thanks Frank. Here I thought there was a nice secret routine built into the
VB IDE or an addon for that Debug code stripping. Yes, I can whip up a file
hunt, peck and destroy (and resave). Thanks for the code example and popping
my hopes! LOL!

All the best Frank.

:)
Rick


"Frank Adam" <fajp@xxxxxxxxxxxxxxxxxxxx> wrote in message
news:obpov19icuouqkaqrbnlqbpp0do238c50o@xxxxxxxxxx
On Wed, 22 Feb 2006 02:34:31 -0600, "WebBiz"
<justask@xxxxxxxxxxxxxxxxx> wrote:

Thanks Frank.

I came upon another logging idea that appears interesting. It's a class
module. So in Main I initialize it with a filename and path (both optional
as it also has hardcoded filename and path within the class) and then
start
adding lines in my code such as you said, beginning/end of each proc.

I'm sure it could be done so many ways that it could keep the group
busy for weeks. :)

I just normally do something like this :
Public Sub DebugLog(sModule As String, sProc As String, _
ParamArray s())

Dim i As Long

Debug.Print Date; Time, sModule, sProc
If Not IsEmpty(s) Then
Debug.Print "variables:"
For i = LBound(s) To UBound(s) Step 2
Debug.Print s(i), s(i + 1)
Next
End If
End Sub

Then for example...

Private Sub Command1_Click()
Dim j As Long, s As String
j = 45
s = "hello"
On Error Resume Next
Err.Raise 6 'just some dummies for the test
Call DebugLog "modulename", "command1_click","errno", Err.Number,
"j", j, "s", s
End Sub

Obviously that changes according to what i'm trying to catch, but the
basic idea is always the same.


"Frank Adam" <fajp@xxxxxxxxxxxxxxxxxxxx> wrote in message
news:mi1ov1p9boliibaf9lk6vfffrpau630qe0@xxxxxxxxxx
Once the bugs are squashed, a simple loop can run through all the
modules and remove all if debugFlag and related lines.

This statement you made has me puzzled though. What simple look allows you
to run through your code to get rid of lines? I've been using Find or
Find/Replace to manually go through my code to strip your change lines.
Are
you telling me there exists a way for me to run a loop to do this?

:-0

I'm not telling. Ask Dag. ;-)

Nah, what i meant was that once you got all the bugs squashed and
happy that you did, you write a separate little program, which rips
through your files in your project folder and strips all the debug
call lines.

Something like below.

BIG NOTE : Although i wrote this in the IDE to make it pretty, i
didn't test it. It's posted purely because IMO, code explains best,
even if it's not quite ready to use. I think this should be, but
that's what you thought about your code too. ;-p

I normally just kludge something up on the run and toss it against
each file separately. Since generally you have a clue about which
modules are causing the problem, there is rarely more than two or
three modules riddled with the debug calls. Another way to handle
would be to have it pick them up off the command line, by just
dragging the module files over the cleaner executable then peeling
them off one by one the Command$ parameter.

It should(providing it's bug free<g>) rip out all the debug lines from
each standard modules(frm,bas,cls,ctl), by finding lines which have
"Call DebugLog" in it, as defined in the Const DEBUG_STR, and omitting
them from the new file.
It writes the new file to a temp file, kills the old file and names
the temp file to oldfile. So no matter what, if tried or used, you
should back up your sources before running it !!
As is, it also needs to run in your project directory, but targeting
it to a different folder should be trivial and of course you should
not break lines when calling the debug procedures, or it will only
remove half of it.. Then again, a line break could be picked up with a
few lines of code added to the code below and taken care of. <shrug>

Option Explicit

Private Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias
"FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As
WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias
"FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As
WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As
Long) As Long

Const DEBUG_STR = "Call DebugLog"

Function CTrim(s As String) As String
Dim l As Long
CTrim = s
l = InStr(CTrim, Chr$(0))
If l Then CTrim = Left$(CTrim, l - 1)
CTrim = Trim(CTrim)
End Function

'is it a module file ? Let's not write into binaries.
Function IsModule(s As String) As Boolean
Dim l As Long
Const MOD_EXTS = "**frmbasclsctl"
l = InStr(1, MOD_EXTS, Right$(s, 3), vbTextCompare)
IsModule = (l <> 0) And (l Mod 3) = 0
End Function

'this cleans it
Sub CleanModule(s As String)
Const TMP_FILE = "tmp.tmp"
Dim hFileIn As Integer, hfileOut As Integer
Dim ss As String

hFileIn = FreeFile
Open s For Input As hFileIn
hfileOut = FreeFile
On Error Resume Next
Kill TMP_FILE
On Error GoTo 0
Open TMP_FILE For Output As hfileOut
Do While Not EOF(hFileIn)
Line Input #hFileIn, s
If Not InStr(s, DEBUG_STR) Then
Print #hfileOut, s
End If
Loop
Close hfileOut
Close hFileIn
Kill s
Name TMP_FILE As s
End Sub

Sub CleanDebug()
Dim s As String, hFind As Long
Dim ff As WIN32_FIND_DATA

hFind = FindFirstFile("*.*", ff)
If hFind Then
Do
If (ff.dwFileAttributes And vbDirectory) <> vbDirectory Then
s = CTrim(ff.cFileName)
If IsModule(s) Then CleanModule s
End If
If FindNextFile(hFind, ff) = 0 Then Exit Do
Loop
FindClose hFind
End If
End Sub

Sub Main()
Call CleanDebug
End Sub
--

Regards, Frank


.

Relevant Pages

  • Project Error
    ... Private Declare Sub Sleep Lib "Kernel32" ... Dim strDataSrc As String ...
    (microsoft.public.vb.bugs)
  • Re: Is there a way to prevent a RichTextBox from scrolling?
    ... Private _isRegex As Boolean ... Public Sub New(ByVal thispattern As String, ... Dim entry As tDict ...
    (microsoft.public.dotnet.framework.windowsforms.controls)
  • Excel Listing tool using VB
    ... Sub ListFiles2() ... Dim directories() As String, CurrentDirectory As String ... Dim dirtopaste, dirok ...
    (microsoft.public.vb.general.discussion)
  • Form Error
    ... SMSDS_CallerID As String ... Private Declare Sub Sleep Lib "kernel32" ... Dim ComString As String ... Dim AppPath As String, FreeFileNo% ...
    (microsoft.public.vb.bugs)
  • Re: Encrypt/hide Password
    ... Public Sub New(ByVal strCryptoName As String) ... ' instantiated crypto class. ... Dim fsKey As New FileStream(strSaveToPath, FileMode.OpenOrCreate, _ ...
    (microsoft.public.scripting.wsh)