Option Explicit
Option Base 0
Private Const EXTERNAL_PROCESS_STARTED = 33
Private Const NO_CONNECTION_ERR =34
Private Const SHELL_MIN_NO_FOCUS = 6
Public Class NetworkConnection
Private drive_ As String
Private user_ As String
Private password_ As String
Private netUseBatchFile_ As String
Public Sub New(drive As String, user As String, _
password As String)
drive_ = drive
user_ = user
password_ = password
End Sub
Public Sub Delete
End Sub
Public Sub connect()
If Not (AddNetworkConnection(password_, user_, drive_)) Then
Error NO_CONNECTION_ERR, _
"Can't establish connection."
End If
End Sub
Public Sub close()
Dim del_command As String
del_command = "cmd /c net use " & drive_ & _
" /delete"
Dim task_id As Integer
task_id% = Shell(del_command,_
SHELL_MIN_NO_FOCUS)
If (Dir$(netUseBatchFile_) <> "") Then
Kill netUseBatchFile_
End If
End Sub
Private Function AddNetworkConnection(passWord As String, _
user As String, drive As String) As Variant
netUseBatchFile_ = CreateNetUseBatchFile
Dim probe_file As String
probe_file = GetTempFile("tmp")
Dim taskId As Integer
taskId% = Shell(netUseBatchFile_ & " " & _
passWord & " " & probe_file & " " & user & " " & drive,_
SHELL_MIN_NO_FOCUS)
If (taskId = EXTERNAL_PROCESS_STARTED) Then
Dim sleep_seconds As Single
sleep_seconds = 2
Dim i As Integer
For i% = 0 To 30
If Dir$(probe_file) <> "" Then
Kill probe_file
AddNetworkConnection = True
Exit Function
Else
Sleep(sleep_seconds)
End If
Next
AddNetworkConnection = False
Exit Function
Else
AddNetworkConnection = False
Exit Function
End If
End Function
Private Function CreateNetUseBatchFile As String
Dim line_feed As String
line_feed = Chr$(13) & Chr$(10)
Dim batch_cmds As String
batch_cmds = _
"@echo off " & line_feed & _
"net use %4 /user:%3 %1 " & line_feed & _
"echo apa > %2 "
Dim file_name As String
file_name = GetTempFile("bat")
Dim file_number As Integer
file_number = Freefile
Open file_name For Output As file_number
Print #file_number, batch_cmds
Close file_number
CreateNetUseBatchFile = file_name
End Function
End Class
Sub Initialize
End Sub
Private Function GetTempFile(extension As String) As String
Dim temp_dir As String
temp_dir = Environ$("TEMP")
Do
Randomize
GetTempFile = temp_dir & |\| & _
"~AI" & Ltrim$(Str$(Round((Rnd()*10000),0))) & "." & extension
Loop Until Dir$(GetTempFile, 0) = ""
End Function
Sub Terminate
End Sub