form1.frm

将xml格式的文件导入到 数据库中,将xml格式的文件导入到 数据库中

'
'    Dim Pic As Picture
'    Set Pic = Me.Icon '将托盘图标设为窗体的图标
''    Set Pic = LoadPicture(App.Path & "\1.ico") '也可从文件中载入
'
' '   Me.TubrTray1.TrayShow Pic '显示托盘
''   Me.TubrTray1.TrayShow '省略后面的参数可载入空图标
'
' '   Me.TubrTray1.TrayTipText = "、ssssssssssssssssssss" '设置鼠标放在托盘上时，显示出来的托盘提示文本

    initSuperGrid
    refr
 
'SuperGrid1.Cell(  = flexTextFlat




End Sub

 
  

Public Sub initSuperGrid()
With SuperGrid1
        .Cols = 7
        .Rows = 8
        .FixedCols = 2
         
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "单据类型"
        .TextMatrix(0, 2) = "源文件路径"
        .TextMatrix(0, 3) = "成功文件路径"
        .TextMatrix(0, 4) = "成功文件日志路径"
        .TextMatrix(0, 5) = "失败后源文件存放路径"
        .TextMatrix(0, 6) = "失败文件日志路径"
        
        .TextMatrix(1, 0) = "1"
        .TextMatrix(2, 0) = "2"
        .TextMatrix(3, 0) = "3"
        .TextMatrix(4, 0) = "4"
        .TextMatrix(5, 0) = "5"
        .TextMatrix(6, 0) = "6"
        .TextMatrix(7, 0) = "7"
        
        .TextMatrix(1, 1) = "销售发货单"
        .TextMatrix(2, 1) = "销售退货单"
        .TextMatrix(3, 1) = "收款单"
        .TextMatrix(4, 1) = "其他出库单"
        .TextMatrix(5, 1) = "其他入库单"
        .TextMatrix(6, 1) = "调拨单"
        .TextMatrix(7, 1) = "材料出库单"
        
        
        '.FormatString = "" & GetString("U8.SA.xsglsql.modrfsown.00234") & "|" & GetString("U8.SA.xsglsql.frmage.01091") & "|" & GetString("U8.SA.xsglsql.frmage.01092")
        .ColWidth(0) = 500       '列数据宽
        .ColWidth(1) = 1000
        .ColWidth(2) = 2000
        .ColWidth(3) = 2000       '列数据宽
        .ColWidth(4) = 2000
        .ColWidth(5) = 2000
        .ColWidth(6) = 2000
        .ColTextWidth(0) = 2000
        .ColTextWidth(1) = 2000
        .ColTextWidth(2) = 2000
        .ColTextWidth(3) = 2000
        .ColTextWidth(4) = 2000
        .ColTextWidth(5) = 2000
        .ColTextWidth(6) = 2000
        .ColAlignment(0) = 3
         .ColAlignment(1) = 3
'        If C <= 1 Then
'        .Ellipsis = flexNoEllipsis
'       ' .Cols = 7
'       '.CellAlignment = 1
'        '.Enabled = False
'        End If
        
        '.AllowUserResizing = AllowUserResizeSettings
        .ColButton(0) = BrowNull
        .ColButton(1) = BrowNull
        .ColButton(2) = UserBrowButton
        .ColButton(3) = UserBrowButton
        .ColButton(4) = UserBrowButton
        .ColButton(5) = UserBrowButton
        .ColButton(6) = UserBrowButton
End With
End Sub

Private Sub SuperGrid1_BrowUser(RetValue As String, ByVal R As Long, ByVal C As Long)
'CommonDialog1.ShowOpen
    Dim LocDir As BROWSEINFO
    Dim RetVal, PidLoc As Long
    Dim Path As String
    Dim Pos As Integer
    Dim myTargetPath As String
Dim SfName As String
Dim SfName1 As String
Dim SfName2 As String
Dim SLong As Long
Dim SLong1 As Long
'SfName = CommonDialog1.FileName
'SLong = Len(SfName)
'MsgBox SLong
'SfName1
'SLong1 = InStrRev(SfName, "\", SLong)
' ' MsgBox CountCharacters(vString$)
'' MsgBox SLong1
'SfName2 = Left(SfName, SLong1)
' SuperGrid1.TextMatrix(R, C) = SfName2
' RetValue = SfName2

    LocDir.hOwner = Me.hWnd
    LocDir.lpszTitle = "请选择一个目录："
    LocDir.ulFlags = BIF_RETURNONLYFSDIRS
    'PidLoc是一个返回值，指向用户定位的目录对应的ID，还不是目录
    PidLoc = SHBrowseForFolder(LocDir)
    Path = Space(512)
    '用SHGetPathFromIDList()API把PidLoc对应的ID转换成对应的目录
    RetVal = SHGetPathFromIDList(ByVal PidLoc, ByVal Path)
    If RetVal Then
        '去掉后面多余的ASCII码为0的字符
        Pos = InStr(Path, Chr$(0))
        myTargetPath = LTrim(RTrim(Left(Path, Pos - 1)))
    End If
  RetValue = myTargetPath

   ' MsgBox myTargetPath

End Sub

Private Sub Command1_Click()
'写文件示例
Dim objs As Object
Set objs = CreateObject("htinterface.inputcls")
    'Set objs = CreateObject("htinterface.inputcls")
Dim strFileName As String '文件名
Dim lngHandle As Long '句柄
Dim strWrite As String '要写入的文本内容
 Dim LocDir As BROWSEINFO
    Dim RetVal, PidLoc As Long
    Dim Path As String
    Dim Pos As Integer
    Dim myTargetPath As String
    LocDir.hOwner = Me.hWnd
    LocDir.lpszTitle = "请选择一个目录："
    LocDir.ulFlags = BIF_RETURNONLYFSDIRS
    'PidLoc是一个返回值，指向用户定位的目录对应的ID，还不是目录
'    PidLoc = SHBrowseForFolder(LocDir)
    Path = Space(512)
    '用SHGetPathFromIDList()API把PidLoc对应的ID转换成对应的目录
    RetVal = SHGetPathFromIDList(ByVal PidLoc, ByVal Path)
    If RetVal Then
        '去掉后面多余的ASCII码为0的字符
        Pos = InStr(Path, Chr$(0))
        myTargetPath = LTrim(RTrim(Left(Path, Pos - 1)))
    End If
strFileName = App.Path + "\mypatch.txt"
lngHandle = FreeFile() '取得句柄
'准备要写入的内容
strWrite = "这些文字将被写入文件。"

Open strFileName For Output As lngHandle '打开文件
With SuperGrid1
'            Print #lngHandle, SuperGrid1.TextMatrix(0, 0) + "," + SuperGrid1.TextMatrix(0, 1) + "," + SuperGrid1.TextMatrix(0, 2) + "," + SuperGrid1.TextMatrix(0, 3) + "," + SuperGrid1.TextMatrix(0, 4) + "," + SuperGrid1.TextMatrix(0, 5) + "," + SuperGrid1.TextMatrix(0, 6) + ","
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(1, 0)) + "," + Trim(SuperGrid1.TextMatrix(1, 1)) + "," + Trim(SuperGrid1.TextMatrix(1, 2)) + "," + Trim(SuperGrid1.TextMatrix(1, 3)) + "," + Trim(SuperGrid1.TextMatrix(1, 4)) + "," + Trim(SuperGrid1.TextMatrix(1, 5)) + "," + Trim(SuperGrid1.TextMatrix(1, 6)) + ",", "a")
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(2, 0)) + "," + Trim(SuperGrid1.TextMatrix(2, 1)) + "," + Trim(SuperGrid1.TextMatrix(2, 2)) + "," + Trim(SuperGrid1.TextMatrix(2, 3)) + "," + Trim(SuperGrid1.TextMatrix(2, 4)) + "," + Trim(SuperGrid1.TextMatrix(2, 5)) + "," + Trim(SuperGrid1.TextMatrix(2, 6)) + ",", "a")
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(3, 0)) + "," + Trim(SuperGrid1.TextMatrix(3, 1)) + "," + Trim(SuperGrid1.TextMatrix(3, 2)) + "," + Trim(SuperGrid1.TextMatrix(3, 3)) + "," + Trim(SuperGrid1.TextMatrix(3, 4)) + "," + Trim(SuperGrid1.TextMatrix(3, 5)) + "," + Trim(SuperGrid1.TextMatrix(3, 6)) + ",", "a")
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(4, 0)) + "," + Trim(SuperGrid1.TextMatrix(4, 1)) + "," + Trim(SuperGrid1.TextMatrix(4, 2)) + "," + Trim(SuperGrid1.TextMatrix(4, 3)) + "," + Trim(SuperGrid1.TextMatrix(4, 4)) + "," + Trim(SuperGrid1.TextMatrix(4, 5)) + "," + Trim(SuperGrid1.TextMatrix(4, 6)) + ",", "a")
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(5, 0)) + "," + Trim(SuperGrid1.TextMatrix(5, 1)) + "," + Trim(SuperGrid1.TextMatrix(5, 2)) + "," + Trim(SuperGrid1.TextMatrix(5, 3)) + "," + Trim(SuperGrid1.TextMatrix(5, 4)) + "," + Trim(SuperGrid1.TextMatrix(5, 5)) + "," + Trim(SuperGrid1.TextMatrix(5, 6)) + ",", "a")
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(6, 0)) + "," + Trim(SuperGrid1.TextMatrix(6, 1)) + "," + Trim(SuperGrid1.TextMatrix(6, 2)) + "," + Trim(SuperGrid1.TextMatrix(6, 3)) + "," + Trim(SuperGrid1.TextMatrix(6, 4)) + "," + Trim(SuperGrid1.TextMatrix(6, 5)) + "," + Trim(SuperGrid1.TextMatrix(6, 6)) + ",", "a")
            Print #lngHandle, objs.Encrypt(Trim(SuperGrid1.TextMatrix(7, 0)) + "," + Trim(SuperGrid1.TextMatrix(7, 1)) + "," + Trim(SuperGrid1.TextMatrix(7, 2)) + "," + Trim(SuperGrid1.TextMatrix(7, 3)) + "," + Trim(SuperGrid1.TextMatrix(7, 4)) + "," + Trim(SuperGrid1.TextMatrix(7, 5)) + "," + Trim(SuperGrid1.TextMatrix(7, 6)) + ",", "a")
            End With
             'Print #lngHandle, SuperGrid1.TextMatrix(0, 0) + "," + SuperGrid1.TextMatrix(0, 1) + "," + SuperGrid1.TextMatrix(0, 2) + "," + SuperGrid1.TextMatrix(0, 3) + "," + SuperGrid1.TextMatrix(0, 4) + "," + SuperGrid1.TextMatrix(0, 5) + "," + SuperGrid1.TextMatrix(0, 6) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(1, 0)) + "," + Trim(SuperGrid1.TextMatrix(1, 1)) + "," + Trim(SuperGrid1.TextMatrix(1, 2)) + "," + Trim(SuperGrid1.TextMatrix(1, 3)) + "," + Trim(SuperGrid1.TextMatrix(1, 4)) + "," + Trim(SuperGrid1.TextMatrix(1, 5)) + "," + Trim(SuperGrid1.TextMatrix(1, 6)) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(2, 0)) + "," + Trim(SuperGrid1.TextMatrix(2, 1)) + "," + Trim(SuperGrid1.TextMatrix(2, 2)) + "," + Trim(SuperGrid1.TextMatrix(2, 3)) + "," + Trim(SuperGrid1.TextMatrix(2, 4)) + "," + Trim(SuperGrid1.TextMatrix(2, 5)) + "," + Trim(SuperGrid1.TextMatrix(2, 6)) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(3, 0)) + "," + Trim(SuperGrid1.TextMatrix(3, 1)) + "," + Trim(SuperGrid1.TextMatrix(3, 2)) + "," + Trim(SuperGrid1.TextMatrix(3, 3)) + "," + Trim(SuperGrid1.TextMatrix(3, 4)) + "," + Trim(SuperGrid1.TextMatrix(3, 5)) + "," + Trim(SuperGrid1.TextMatrix(3, 6)) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(4, 0)) + "," + Trim(SuperGrid1.TextMatrix(4, 1)) + "," + Trim(SuperGrid1.TextMatrix(4, 2)) + "," + Trim(SuperGrid1.TextMatrix(4, 3)) + "," + Trim(SuperGrid1.TextMatrix(4, 4)) + "," + Trim(SuperGrid1.TextMatrix(4, 5)) + "," + Trim(SuperGrid1.TextMatrix(4, 6)) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(5, 0)) + "," + Trim(SuperGrid1.TextMatrix(5, 1)) + "," + Trim(SuperGrid1.TextMatrix(5, 2)) + "," + Trim(SuperGrid1.TextMatrix(5, 3)) + "," + Trim(SuperGrid1.TextMatrix(5, 4)) + "," + Trim(SuperGrid1.TextMatrix(5, 5)) + "," + Trim(SuperGrid1.TextMatrix(5, 6)) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(6, 0)) + "," + Trim(SuperGrid1.TextMatrix(6, 1)) + "," + Trim(SuperGrid1.TextMatrix(6, 2)) + "," + Trim(SuperGrid1.TextMatrix(6, 3)) + "," + Trim(SuperGrid1.TextMatrix(6, 4)) + "," + Trim(SuperGrid1.TextMatrix(6, 5)) + "," + Trim(SuperGrid1.TextMatrix(6, 6)) + ","
'            Print #lngHandle, Trim(SuperGrid1.TextMatrix(7, 0)) + "," + Trim(SuperGrid1.TextMatrix(7, 1)) + "," + Trim(SuperGrid1.TextMatrix(7, 2)) + "," + Trim(SuperGrid1.TextMatrix(7, 3)) + "," + Trim(SuperGrid1.TextMatrix(7, 4)) + "," + Trim(SuperGrid1.TextMatrix(7, 5)) + "," + Trim(SuperGrid1.TextMatrix(7, 6)) + ","
'            End With
'
Close #lngHandle
Set objs = Nothing
'    Print #lngHandle, strWrite '写入文本
'    Close lngHandle '关闭文件
End Sub

Private Sub Command3_Click()
'Dim ss As String
'Dim sss As String
'Dim lntRet As String
''ss = Encrypt("大 ", "a")
'ss = StringEnDeCodecn
'ss1 = Encrypt("大 ", "a")
'ss1 = Encrypt("大　", "a")
'ss1 = Encrypt("大 ", "a")
Unload Me   '卸载当前窗体
End Sub

Private Sub SuperGrid1_CellDataCheck(RetValue As String, RetState As MsSuperGrid.OpType, ByVal R As Long, ByVal C As Long)

With SuperGrid1
'MsgBox SuperGrid1.Col
'MsgBox SuperGrid1.Row
If FileExist(RetValue) = False Then
 RetState = dbCandel
End If

' RetState = dbCandel
End With

End Sub

'Private Sub Timer1_Timer()
'    Dim Pic As Picture
'    If Me.Timer1.Tag = "" Then
'        Me.TubrTray1.TrayShow     '省略后面的参数可载入空图标
'        Me.Timer1.Tag = "闪烁"
'    Else
'
'        Set Pic = Me.Icon
'        Me.TubrTray1.TrayShow Pic '改变托盘图标，也用TrayShow方法
'        Me.Timer1.Tag = ""
'    End If
'    DoEvents
'End Sub

Private Sub TubrTray1_Click()
Me.Show
End Sub