module1.bas

多种数据库或数据文件转化成工行网上银行文件格式

Attribute VB_Name = "SBMOD"
Option Explicit
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Public rsNew As ADODB.Recordset
Public cnNew As ADODB.Connection
Public addFlag As Boolean
Public Function GetNodeValue(ByVal start_at_node As IXMLDOMNode, _
ByVal node_name As String, _
Optional ByVal default_value As String = "") As String
Dim value_node As IXMLDOMNode

Set value_node = start_at_node.selectSingleNode(".//" & node_name)
If value_node Is Nothing Then
GetNodeValue = default_value
Else
GetNodeValue = value_node.Text
End If
End Function

'连接数据库
Public Function OpenCn(SqlDbName As String, SqlServerkind As Integer, SqlDbPub As String, SqlDbUser As String, SqlDbPwl As String) As Boolean
On Error GoTo strErrMag
Set cnNew = New ADODB.Connection
cnNew.ConnectionTimeout = 30
cnNew.CursorLocation = adUseClient
Select Case SqlServerkind
       Case 0 'MSSQL
'cnNew.ConnectionString = "driver={" & SqlServer & "};" & _
"server=" & SqlDbName & ";uid=" & SqlDbUser & _
";pwd=" & SqlDbPwl & ";database=" & SqlDbPub & ""
cnNew.ConnectionString = "Provider=MSDASQL;" & _
                   "Driver={SQL Server};" & _
                   "Server=" & SqlDbName & ";" & _
                   "Database=" & SqlDbPub & ";" & _
                   "Uid=" & SqlDbUser & ";" & _
                   "Pwd=" & SqlDbPwl & ";"

Case 1 'new oracle
cnNew.ConnectionString = "Provider=OraOLEDB.Oracle;" & _
                   "Data Source=" & SqlDbName & ";" & _
                   "User Id=" & SqlDbUser & ";" & _
                   "Password=" & SqlDbPwl & ";"

Case 2 'old oracle
cnNew.ConnectionString = "Provider=msdaora;" & _
                   "Data Source=" & SqlDbName & ";" & _
                   "User Id=" & SqlDbUser & ";" & _
                   "Password=" & SqlDbPwl & ";"

Case 3 'access
cnNew.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SqlDbName & ";" & _
"User Id=admin;" & _
"Password=;"

Case 4 'excel
cnNew.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & SqlDbName & ";" & _
                   "Extended Properties=""Excel 8.0;HDR=Yes;"";"


'cnNew.Provider = "sqloledb"
'cnNew.Properties("data source").Value = SqlDbName '"" 'SQL服务器的名
'cnNew.Properties("initial catalog").Value = SqlDbPub '"pubs" '库名
'cnNew.Properties("integrated security").Value = "SSPI" '登陆类型
'cnNew.Properties("user id").Value = SqlDbUser '"sa"
'cnNew.Properties("password").Value = SqlDbPwl ' "wwww"
'‘For the current Oracle ODBC Driver from Microsoft:

'oConn.Open "Driver={Microsoft ODBC for Oracle};" & _
                   "Server=OracleServer.world;" & _
                   "Uid=myUsername;" & _
                   "Pwd=myPassword;"

'For the older Oracle ODBC Driver from Microsoft:

'oConn.Open "Driver={Microsoft ODBC Driver for Oracle};" & _
                   "ConnectString=OracleServer.world;" & _
                   "Uid=myUsername;" & _
                   "Pwd=myPassword;"
End Select

cnNew.Open

OpenCn = True
addFlag = True
Exit Function
strErrMag:

MsgBox cnNew.Errors
addFlag = False
End
End Function
Public Sub Clocn()
'闭关数据库
On Error Resume Next
If cnNew.State <> adStateClosed Then cnNew.Close
Set cnNew = Nothing
End Sub

Public Function GetINI(AppName As String, KeyName As String, FileName As String) As String
On Error Resume Next
   Dim RetStr As String
   RetStr = String(1024, Chr(0))
   GetINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function