Difference between revisions of "File System + File I/O in VB6"

From Free Knowledge Base- The DUCK Project: information for everyone
Jump to: navigation, search
m (Other File System Methods)
 
Line 79: Line 79:
 
   End If
 
   End If
 
  End Sub
 
  End Sub
 +
 +
The above includes an optional command line parameter.  The program being launched, in this example, checks for that command line parameter.  It uses the reserved constant "Command".
 +
 +
Private Function CheckLauncherParamter()
 +
  If InStr(LCase(Command), "/verified") > 0 Then
 +
    CheckLauncherParamter = True
 +
    blnDebug = False
 +
    mnuFileExit.Enabled = False
 +
  ElseIf InStr(LCase(Command), "/debug") > 0 Then
 +
    CheckLauncherParamter = True
 +
    blnDebug = True
 +
    mnuFileExit.Enabled = True
 +
  Else
 +
    CheckLauncherParamter = False
 +
  End If
 +
End Function
  
 
 
 
 

Latest revision as of 15:59, 7 February 2008

Microsoft Scripting Runtime / FSO

*must add 'reference' to "Microsoft Scripting Runtime"

  • Be sure to "Set fso = Nothing" unless you like memory leaks and virtual memory errors in Windows.

Write/Create a new file using FileSystemObject

 Dim fso As New FileSystemObject, fsoStream As TextStream
 Dim rec1, strLine, strFileSpec
 Dim cnt0 As Integer, tag1 As Integer
 strFileSpec = Environ("HOMEPATH") & "\My Documents\kaching.log"
 strLine = "kaching incident " & Date & " " & Format(time, "HH:mm:ss") & vbCrLf
 Set fsoStream = fso.CreateTextFile(strFileSpec, True)
 fsoStream.Write strLine
 fsoStream.Close
 Set fsoStream = Nothing: Set fso = Nothing

 

Check if File Exists

Private Function LocalFileExists() As Boolean
  Dim fso As New FileSystemObject
  Dim strSrc As String, strDst As String
  strSrc = Trim("" & strRemoteFileName)
  strDst = strLCRMpath & "\" & Trim("" & strRemoteFileName)
  If fso.FileExists(strDst) Then LocalFileExists = True Else LocalFileExists = False
  Set fso = Nothing
End Function

 

Delete File

strDst = strLCRMpath & "\" & Trim("" & strRemoteFileName)
fso.DeleteFile strDst

 

Copy File (Backup File)

fso.CopyFile strFileSpec, Replace(strFileSpec, ".xml", ".bak")

With error handling:

On Error GoTo SkipBackup
  If blnNoWriteFileInDebug <> True Then fso.CopyFile strFileSpec, Replace(strFileSpec, ".xml", ".bak")
SkipBackup:
On Error GoTo 0

 

Write if exists, create if doesn't exist using FileSystemObject

 If fso.FileExists(strFileSpec) Then
   Set fsoStream = fso.OpenTextFile(strFileSpec, 2)
 Else
   Set fsoStream = fso.CreateTextFile(strFileSpec, True)
 End If
 
 fsoStream.Write strLine
 fsoStream.Close
 Set fsoStream = Nothing: Set fso = Nothing
 ' strFileSpec, 1 : ForReading 2 : ForWriting  8 : ForAppending  

 

Other File System Methods

Launch Another Program (any) From Your VB Program

Private Sub launchSLXAssist()
  Dim intExecute%
  If InStr(LCase(Command), "/interpreter") > 0 Then
    MsgBox "Shell SLXAssist.exe"
  Else
    intExecute% = Shell("SLXAssist.exe /verified", 1)
  End If
End Sub

The above includes an optional command line parameter. The program being launched, in this example, checks for that command line parameter. It uses the reserved constant "Command".

Private Function CheckLauncherParamter()
  If InStr(LCase(Command), "/verified") > 0 Then
    CheckLauncherParamter = True
    blnDebug = False
    mnuFileExit.Enabled = False
  ElseIf InStr(LCase(Command), "/debug") > 0 Then
    CheckLauncherParamter = True
    blnDebug = True
    mnuFileExit.Enabled = True
  Else
    CheckLauncherParamter = False
  End If
End Function

 

Check if Network Path and File are available

Private Sub checkFile01()
'   [step 1]: check to see if the network path and autoupdate.xml are available
  Dim fLen As Integer
  Dim strResponse%
  tmr.Enabled = False
  intbarProg = 0: barProg.Value = intbarProg

  On Error Resume Next
  fLen = Len(Dir$(xmlfilepath))
  strResponse% = vbRetry
  While strResponse% = vbRetry
    If Err Or fLen = 0 Then
    ' file dosent exist
      strResponse% = MsgBox("Error: XML inaccessible for auto-update!", vbAbortRetryIgnore, "SALESLOGIX ASSISTANT")
    Else
    ' file exists
      strResponse% = 0
    End If
  Wend
  On Error GoTo 0
End Sub