modsfis.bas

这是一个用来打印手机三包凭证的源代码

Attribute VB_Name = "modSfis"
Option Explicit



Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Public Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Public Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long


Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long



Public Const INIFILE = "D:\Warranty\Sfis.ini"

Public Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String
    lpRemoteName As String
    lpComment As String
    lpProvider As String
End Type




Public Const NO_ERROR = 0
Public Const CONNECT_UPDATE_PROFILE = &H1
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_REMEMBERED = &H3
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2

'DebugMode
Public gstrDebugMode As String



Public gstrSpecDirectory As String
Public gstrSfisServerHost As String
Public gstrRequestDir As String
Public gstrResponseDir As String
Public gstrResultDir As String
Public gstrRequestLogDrive As String
Public gstrResponseLogDrive As String
Public gstrResultLogDrive As String
Public gstrUserName As String
Public gstrPassword As String
Public gstrRePrintResultLogDrive As String


'RePrint
Public gstrRePrintRequestDir As String
Public gstrRePrintResponseDir As String
Public gstrRePrintResultDir As String
Public gstrRePrintRequestLogDrive As String
Public gstrRePrintResponseLogDrive As String






Public gstrLineNo As String
Public gstrStation As String
Public gstrEmployee As String








Public Sub ConfigInfoRead()
   
   'DebugMode Judgement
   gstrDebugMode = UCase(Getini("System", "DebugMode"))
   
   'Station&Opertor Information
   
   gstrLineNo = Getini("ClientInfo", "LineNo")
   gstrStation = Getini("ClientInfo", "Station")
   gstrEmployee = Getini("ClientInfo", "Employee")
   
   
   
   'Normal Print Logdrive Info
   
   gstrSfisServerHost = Getini("SfServerInfo", "HostName")
   
   gstrRequestDir = Getini("SfServerInfo", "RequestDir")
   gstrResponseDir = Getini("SfServerInfo", "ResponseDir")
   gstrResultDir = Getini("SfServerInfo", "ResultDir")
   gstrRequestLogDrive = Getini("ClientInfo", "RequestLogDrive")
   gstrResponseLogDrive = Getini("ClientInfo", "ResponseLogDrive")
   gstrResultLogDrive = Getini("ClientInfo", "ResultLogDrive")
   
   'RePrint LogDrive Info
   
   gstrRePrintRequestDir = Getini("SfServerInfo", "RePrintRequestDir")
   gstrRePrintResponseDir = Getini("SfServerInfo", "RePrintResponseDir")
   gstrRePrintResultDir = Getini("SfServerInfo", "RePrintResultDir")
   gstrRePrintRequestLogDrive = Getini("ClientInfo", "RePrintRequestLogDrive")
   gstrRePrintResponseLogDrive = Getini("ClientInfo", "RePrintResponseLogDrive")
   gstrRePrintResultLogDrive = Getini("ClientInfo", "RePrintResultLogDrive")
   
   
   'Account
   gstrUserName = Getini("SfServerInfo", "UserName")
   gstrPassword = Getini("SfServerInfo", "Password")
   
   'Print Positon Ctrol
   
   gstrBaseX = Getini("BasePosition", "BaseX")
   gstrBaseY = Getini("BasePosition", "BaseY")
   gstrGap = Getini("BasePosition", "Gap")
   gstrGapCusToSale = Getini("BasePosition", "GapCusToSale")
  
   gstrModel = Getini("DEFAULT", "Model")
   gstrLocation = Getini("DEFAULT", "Location")
   
   'Battery vendor Information
   gstrBatteryLocation = Getini("Battery", "Location")
   gstrBatteryVendor = Getini("Battery", "Vendor")
   gstrBattery1_Model = Getini("Battery", "Batt1_Model")
   gstrBattery2_Model = Getini("Battery", "Batt2_Model")
   
   'TripCharger Information
   gstrTripChargerModel = Getini("TripCharger", "Model")
   gstrTripChargerLocation = Getini("TripCharger", "Location")
   
   
End Sub
Public Function NetConnection(strConnectPCName As String, DirName As String, LogdriveName As String) As Boolean

   Dim strConnectPCNmae As String
   Dim mResourceInfo As NETRESOURCE
   
   
With mResourceInfo
    .dwScope = RESOURCE_GLOBALNET
    .dwType = RESOURCETYPE_DISK
    .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
    .dwUsage = RESOURCEUSAGE_CONNECTABLE
    .lpLocalName = LogdriveName
    .lpRemoteName = "\\" + strConnectPCName + "\" + DirName
End With

NetConnection = IIf(WNetAddConnection2(mResourceInfo, gstrPassword, gstrUserName, CONNECT_UPDATE_PROFILE) = NO_ERROR, True, False)

End Function
Public Sub NetCancelConnection(LogdriveName As String)
Dim CancelResult As Long
    CancelResult = WNetCancelConnection2(LogdriveName, CONNECT_UPDATE_PROFILE, True)
End Sub


Public Function Getini(strKey As String, strItem As String) As String
Dim x As Long
Dim buff As String * 128
GetPrivateProfileString strKey, strItem, "", buff, 128, INIFILE
x = InStr(buff, Chr(0))
Getini = Trim(Left(buff, x - 1))
End Function
Public Sub Setini(strKey As String, strItem As String, str As String)
Dim buff As String * 128
buff = str + Chr(0)
WritePrivateProfileString strKey, strItem, buff, INIFILE
End Sub

Private Sub MessDisplay(strKey As String, strItem As String, strMess As String)

        MsgBox "[" + strKey + "]" + strItem + "=" + strMess + "Setting Error!", vbCritical
        End
        
End Sub







Public Sub SfisConnect()

         SfisDisConnect
         
         If NetConnection(gstrSfisServerHost, gstrRequestDir, gstrRequestLogDrive) = False Then
            
            MsgBox gstrSfisServerHost + "/" + gstrRequestDir + "Connection Error!!", vbCritical, "NetConnection Error!"
            End
         End If
         
         If NetConnection(gstrSfisServerHost, gstrResponseDir, gstrResponseLogDrive) = False Then
            
            MsgBox gstrSfisServerHost + "/" + gstrResponseDir + "Connection Error!!", vbCritical, "NetConnection Error!"
            End
         End If
         
         If NetConnection(gstrSfisServerHost, gstrResultDir, gstrResultLogDrive) = False Then
            
            MsgBox gstrSfisServerHost + "/" + gstrResultDir + "Connection Error!!", vbCritical, "NetConnection Error!"
            End
            
         End If
         
         'RePrint LogDrive Connection
         
         If NetConnection(gstrSfisServerHost, gstrRePrintRequestDir, gstrRePrintRequestLogDrive) = False Then
            
            MsgBox gstrSfisServerHost + "/" + gstrRePrintRequestDir + "Connection Error!!", vbCritical, "NetConnection Error!"
            End
         End If
         
         If NetConnection(gstrSfisServerHost, gstrRePrintResponseDir, gstrRePrintResponseLogDrive) = False Then
            
            MsgBox gstrSfisServerHost + "/" + gstrRePrintResponseDir + "Connection Error!!", vbCritical, "NetConnection Error!"
            End
         End If
         
         If NetConnection(gstrSfisServerHost, gstrRePrintResultDir, gstrRePrintResultLogDrive) = False Then
            
            MsgBox gstrSfisServerHost + "/" + gstrRePrintResultDir + "Connection Error!!", vbCritical, "NetConnection Error!"
            End
            
         End If
         
         
               
End Sub
Public Sub SfisDisConnect()

       'DisConnect Normal LogDrive
       NetCancelConnection gstrRequestLogDrive
       NetCancelConnection gstrResponseLogDrive
       NetCancelConnection gstrResultLogDrive
       
      'DisConnect RePrint LogDrive
       NetCancelConnection gstrRePrintRequestLogDrive
       NetCancelConnection gstrRePrintResponseLogDrive
       NetCancelConnection gstrRePrintResultLogDrive
      
       
       
       
       
End Sub


Public Sub SendRequestFile(strTypeDrive As String)
    Dim strRemoteFile As String
    Dim strLocalFile As String
    Dim strResponseFile As String
    Dim strSN As String
    
    Dim strDrive As String
    
    Select Case UCase(strTypeDrive)
           Case "NORMAL"
                strDrive = gstrRequestLogDrive
           Case "REPRINT"
                strDrive = gstrRePrintRequestLogDrive
           Case Else
                Stop
    End Select
        
    
    
    
    strSN = Trim(frmMain.txtSN)
    
    
    On Error GoTo Errhandle
    
    'If old response file exists,Delete it
    strResponseFile = strDrive + "\" + strSN + ".sf"
    If Dir(strResponseFile) <> "" Then DeleteFileEx strResponseFile
    
        
    strRemoteFile = strDrive + "\" + strSN + ".txt"
    strLocalFile = App.Path + "\Sfis\" + strSN + ".txt"         '03-07-16 20:24 at home/Gao
    
    
    'Save a txt File
    
    Open strLocalFile For Output As #1
         Select Case UCase(strTypeDrive)
                Case "NORMAL"
                      Print #1, strSN + ";" + gstrLineNo + ";" + gstrStation + ";"
                Case "REPRINT"
                      Print #1, strSN + ";"
                Case Else
                      Stop
         End Select
    Close #1
    
    Wait 50
    
    If gstrDebugMode = "1" Then
        CopyFileEx strLocalFile, strRemoteFile
    End If