form1.frm

请运行setup.exe 对软件进行安装

    
    strSQl = (AdoRs1!password1)
    AdoRs1.Close
  If DigestStrToHexStr(Text2.Text) = strSQl Then
  If Text3.Text = Text4.Text Then
  cn.Execute "update   set1   set   password1='" + DigestStrToHexStr(Text3.Text) + "'"
  MsgBox "密码更改成功！"
  Text2.Text = ""
  Text3.Text = ""
  Text4.Text = ""
  Else
  MsgBox "验证密码不正确！"
  End If
  Else
  MsgBox "原始密码错误"

  End If
End If
End Sub

Private Sub Command21_Click()
On Error Resume Next
Frame5.Visible = False
Frame1.Visible = False
End Sub

Private Sub Command22_Click()
 On Error GoTo aa
   If shlShell Is Nothing Then
         Set shlShell = New Shell32.Shell
    End If
  
    Set shlFolder = shlShell.BrowseForFolder(Me.hwnd, "请选择文件夹", _
                                            BIF_RETURNONLYFSDIRS)
    If Not shlFolder Is Nothing Then
           Dim fs As New FileSystemObject

   '′利用filesystemobject对象的fileexists

   '方法判断文件是否存在
   If fs.FolderExists(shlFolder.Items.Item.Path) Then
   cn.Execute "update   set1   set   savepath1='" + shlFolder.Items.Item.Path + "'"
   'Frame1.Visible = False
   Text1.Text = shlFolder.Items.Item.Path
   MsgBox "更改设置成功！"

   Else
   MsgBox "路径选择错误！"
   End If
   
        
    End If
GoTo cc:
aa: MsgBox "此文件夹不可选！请重新选择。"
Call Command22_Click
cc:
End Sub

Private Sub Command3_Click()
On Error Resume Next
Frame3.Visible = False
End Sub

Private Sub Command4_Click()
On Error Resume Next
  Dim strSQl As String
   strSQl = "select * from csz"

  AdoRs.Open strSQl, cn, adOpenKeyset, adLockOptimistic

  AdoRs!username1 = username1.Text
  AdoRs!phone1 = phone1.Text
  AdoRs!address1 = address1.Text
  AdoRs!post1 = post1.Text
  AdoRs!jyfw1 = jyfw1.Text
  AdoRs!tbcsmc1 = tbcsmc1.Text
  AdoRs!dz1 = dz1.Text
  AdoRs!cshylb1 = cshylb1.Text
  AdoRs!csnsshzz1 = csnsshzz1.Text
  AdoRs!yymj1 = yymj1.Text
  AdoRs!ywdxbf1 = ywdxbf1.Text
  AdoRs!jzjg1 = jzjg1.Text
  AdoRs!fhsszk1 = fhsszk1.Text
  AdoRs!mrzrxe1 = mrzrxe1.Text
  AdoRs!ljzrxe1 = ljzrxe1.Text
  AdoRs!jzbxf1 = jzbxf1.Text
  AdoRs!bxf1 = bxf1.Text
  AdoRs!bxf2 = bxf2.Text
  AdoRs!bxqjy1 = bxqjy1.Text
  AdoRs!bxqjzn1 = bxqjzn1.Text
  AdoRs!bxqjzy1 = bxqjzy1.Text
  AdoRs!bxqjzr1 = bxqjzr1.Text
  AdoRs!bxqjdn1 = bxqjdn1.Text
  AdoRs!bxqjdy1 = bxqjdy1.Text
  AdoRs!bxqjdr1 = bxqjdr1.Text
  AdoRs!bxhtzyjjfs1 = bxhtzyjjfs1.Text
  AdoRs!tbyd1 = tbyd1.Text
  AdoRs!bxrlxdz1 = bxrlxdz1.Text
  AdoRs!yzbm1 = yzbm1.Text
  AdoRs!cz1 = cz1.Text
  AdoRs!hb1 = hb1.Text
  AdoRs!zd1 = zd1.Text
  AdoRs!jb1 = jb1.Text
  'AdoRs!n1 = n1.Text
  'AdoRs!y1 = y1.Text
  'AdoRs!r1 = r1.Text
  
  
  AdoRs.Update
  AdoRs.Close

End Sub

Private Sub Command5_Click()
On Error Resume Next
startb
End Sub

Private Sub Command6_Click()
On Error Resume Next

    Dim WordTemps As New Word.Application

WordTemps.Documents.Add App.Path + "\发票模板.doc", False

  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxdh1"

  WordTemps.Selection.TypeText bxdh1.Text
  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxdh2"

  WordTemps.Selection.TypeText bxdh1.Text
  WordTemps.Selection.GoTo wdGoToBookmark, , , "username1"

  WordTemps.Selection.TypeText username1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxf1"

  WordTemps.Selection.TypeText bxf1.Text
  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxf2"

  WordTemps.Selection.TypeText bxf2.Text
  


 '   WordTemps.Selection.GoTo wdGoToBookmark, , , "jb1"

  'WordTemps.Selection.TypeText jb1.Text



    WordTemps.Selection.GoTo wdGoToBookmark, , , "n1"

  WordTemps.Selection.TypeText n1.Text
  
  
    WordTemps.Selection.GoTo wdGoToBookmark, , , "y1"

  WordTemps.Selection.TypeText y1.Text
  
  
    WordTemps.Selection.GoTo wdGoToBookmark, , , "r1"

  WordTemps.Selection.TypeText r1.Text
  
  
        WordTemps.ActiveDocument.SaveAs FileName:=App.Path + "\保险发票.doc", FileFormat:=wdFormatDocument, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
        WordTemps.ActiveDocument.PrintOut
        DoEvents
        WordTemps.Visible = False '显示WORD窗口

WordTemps.Quit
MsgBox "打印操作已经发出，请保持打印机连接"
'If MsgBox("打印完成!是否将数据保存到数据库！", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then Call Command14_Click

End Sub

Private Sub Command9_Click()
On Error Resume Next
Text1.Text = savepath1
Frame1.Visible = False
End Sub

Private Sub Command7_Click()
On Error Resume Next
   Dim strSQl As String
   strSQl = "select * from set1"
   Dim AdoRs1 As New ADODB.Recordset
  AdoRs1.Open strSQl, cn, adOpenKeyset, adLockReadOnly
  Text1.Text = AdoRs1!savepath1
  AdoRs1.Close
savepath1 = Text1.Text
Frame1.Visible = True
End Sub

Private Sub Command8_Click()
On Error Resume Next
   Dim fs As New FileSystemObject

   '′利用filesystemobject对象的fileexists

   '方法判断文件是否存在
   If fs.FolderExists(Text1.Text) Then
   cn.Execute "update   set1   set   savepath1='" + Text1.Text + "'"
   'Frame1.Visible = False
   MsgBox "更改设置成功！"
   
   Else
   MsgBox "路径选择错误！"
   End If
   
End Sub

Private Sub cshylb1_GotFocus()
On Error Resume Next
AutoSelect cshylb1
End Sub

Private Sub cshylb1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Or KeyCode = 10 Then SendKeys ((vbTab))
End Sub

Private Sub csnsshzz1_GotFocus()
On Error Resume Next
AutoSelect csnsshzz1
End Sub

Private Sub csnsshzz1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Or KeyCode = 10 Then SendKeys ((vbTab))
End Sub

Private Sub cz1_GotFocus()
On Error Resume Next
AutoSelect cz1
End Sub

Private Sub cz1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Or KeyCode = 10 Then SendKeys ((vbTab))
End Sub

Private Sub Dir1_Change()
On Error Resume Next

Text1.Text = Dir1.Path

End Sub

Private Sub Dir1_Click()
On Error Resume Next
Text1.Text = Dir1.Path

End Sub

Private Sub Drive1_Change()
On Error Resume Next
Dir1.Path = Drive1.Drive
End Sub

Private Sub dz1_GotFocus()
On Error Resume Next
AutoSelect dz1
End Sub

Private Sub dz1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Or KeyCode = 10 Then SendKeys ((vbTab))
End Sub

Private Sub fhsszk1_GotFocus()
On Error Resume Next
AutoSelect fhsszk1
End Sub

Private Sub fhsszk1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Or KeyCode = 10 Then SendKeys ((vbTab))
End Sub



  Private Sub Form_Load()


On Error Resume Next
Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 1)
Call SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3)

form1.ZOrder 0
  Frame4.Left = 0
  Frame4.Top = 120

  Frame1.Left = 480
  Frame1.Top = 460
    Frame3.Left = 480
  Frame3.Top = 460
  If cn.State = 1 Then
   
     cn.Close

  End If

  cn.CursorLocation = adUseClient

 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\set.dll;" & _
 ";Jet OLEDB:Database password=3013986"
 
   Dim strSQl As String
   strSQl = "select * from set1"
   Dim AdoRs1 As New ADODB.Recordset
  AdoRs1.Open strSQl, cn, adOpenKeyset, adLockReadOnly
  Text1.Text = AdoRs1!savepath1
  AdoRs1.Close
  If UCase(Text1.Text) = "C:\HZGZ" Or UCase(Text1.Text) = "C:/HZGZ" Or UCase(Text1.Text) = "C:/HZGZ/" Or UCase(Text1.Text) = "C:\HZGZ\" Then
     
     Dim fs As New FileSystemObject
If Not fs.FolderExists(Text1.Text) Then
  fs.CreateFolder ("c:/hzgz")
End If

  End If
  AdoRs1.Open "select bxdh1 from bxd", cn, adOpenKeyset, adLockReadOnly
  K = 0
  Do While Not AdoRs1.EOF
  If AdoRs1!bxdh1 <> "" Then
   If K < CInt(AdoRs1!bxdh1) Then
    K = CInt(AdoRs1!bxdh1)
   End If
  End If
  AdoRs1.MoveNext
 Loop
  bxdh1.Text = Format(K + 1, "000000")
  AdoRs1.Close

n1.Text = Year(Now)
y1.Text = Month(Now)
r1.Text = Day(Now)

'SendMessage List1.Hwnd, LB_SETHORIZONTALEXTENT, 1.02 * MaxlongStr(), ByVal 0&
  
   Set AdoRs1 = Nothing
  startb
  End Sub
    Private Function MaxlongStr() As Integer
  On Error Resume Next
Dim Templen     As Integer
  For I = 0 To List1.ListCount - 1
      If Templen < Me.TextWidth(List1.List(I)) Then
          Templen = Me.TextWidth(List1.List(I))
      End If
  Next I
  MaxlongStr = Templen
  End Function

  '开始导出数据

  Private Sub Command1_Click()
  
On Error Resume Next
     Dim strSQl As String
   strSQl = "select * from set1"

  AdoRs.Open strSQl, cn, adOpenKeyset, adLockReadOnly
  strSQl = AdoRs!savepath1
  AdoRs.Close


   Dim fs As New FileSystemObject
If Not fs.FolderExists(strSQl) Then
  MsgBox "请正确设置存放路径"
  Frame2.Visible = True
Else
  
    Dim WordTemps As New Word.Application
  Command1.Enabled = False


  'Dim REC As Integer

  'Dim i As Integer
WordTemps.Documents.Add App.Path + "\合同模板.doc", False

  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxdh1"

  WordTemps.Selection.TypeText bxdh1.Text


  WordTemps.Selection.GoTo wdGoToBookmark, , , "username1"

  WordTemps.Selection.TypeText username1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "phone1"

  WordTemps.Selection.TypeText phone1.Text
    WordTemps.Selection.GoTo wdGoToBookmark, , , "address1"

  WordTemps.Selection.TypeText address1.Text
  WordTemps.Selection.GoTo wdGoToBookmark, , , "post1"

  WordTemps.Selection.TypeText post1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "jyfw1"

  WordTemps.Selection.TypeText jyfw1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "tbcsmc1"

  WordTemps.Selection.TypeText tbcsmc1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "dz1"

  WordTemps.Selection.TypeText dz1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "cshylb1"

  WordTemps.Selection.TypeText cshylb1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "csnsshzz1"

  WordTemps.Selection.TypeText csnsshzz1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "yymj1"

  WordTemps.Selection.TypeText yymj1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "ywdxbf1"

  WordTemps.Selection.TypeText ywdxbf1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "jzjg1"

  WordTemps.Selection.TypeText jzjg1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "fhsszk1"
  WordTemps.Selection.TypeText fhsszk1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "mrzrxe1"

  WordTemps.Selection.TypeText mrzrxe1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "ljzrxe1"

  WordTemps.Selection.TypeText ljzrxe1.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "jzbxf1"

  WordTemps.Selection.TypeText jzbxf1.Text
  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxf1"

  WordTemps.Selection.TypeText bxf1.Text
  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxf2"

  WordTemps.Selection.TypeText bxf2.Text
  
  WordTemps.Selection.GoTo wdGoToBookmark, , , "bxqjy1"

  WordTemps.Selection.TypeText bxqjy1.Text
    WordTemps.Selection.GoTo wdGoToBookmark, , , "bxqjzn1"

  WordTemps.Selection.TypeText bxqjzn1.Text
    WordTemps.Selecti