firform.frm

vb 调用ＩＢＭ ｄｏｍｉｎｏ ｓｅｒｖｅｒ数据库的例子

VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.Form firform 
   Caption         =   "主界面"
   ClientHeight    =   5865
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8700
   Icon            =   "FirForm.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5865
   ScaleWidth      =   8700
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   735
      Left            =   1800
      TabIndex        =   4
      Top             =   6360
      Visible         =   0   'False
      Width           =   2895
   End
   Begin InetCtlsObjects.Inet Inet1 
      Left            =   840
      Top             =   6480
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin VB.CommandButton Command6 
      Caption         =   "退     出"
      Height          =   615
      Left            =   360
      TabIndex        =   3
      Top             =   2040
      Width           =   2895
   End
   Begin VB.CommandButton Command5 
      BackColor       =   &H80000004&
      Caption         =   "文档管理库"
      Height          =   615
      Left            =   360
      TabIndex        =   2
      Top             =   1200
      Width           =   2895
   End
   Begin VB.CommandButton Command4 
      Caption         =   "发    文"
      Height          =   615
      Left            =   360
      TabIndex        =   1
      Top             =   2880
      Visible         =   0   'False
      Width           =   2895
   End
   Begin VB.CommandButton Command3 
      Caption         =   "收     文"
      Height          =   615
      Left            =   360
      TabIndex        =   0
      Top             =   3720
      Visible         =   0   'False
      Width           =   2895
   End
   Begin VB.PictureBox Picture1 
      Align           =   1  'Align Top
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   9705
      Left            =   0
      Picture         =   "FirForm.frx":030A
      ScaleHeight     =   9705
      ScaleWidth      =   8700
      TabIndex        =   5
      Top             =   0
      Width           =   8700
      Begin VB.CommandButton Command2 
         Caption         =   "Command2"
         Height          =   615
         Left            =   360
         TabIndex        =   9
         Top             =   4680
         Visible         =   0   'False
         Width           =   2895
      End
      Begin VB.PictureBox Picture2 
         BorderStyle     =   0  'None
         Height          =   735
         Left            =   -120
         Picture         =   "FirForm.frx":BF5F
         ScaleHeight     =   735
         ScaleWidth      =   8895
         TabIndex        =   8
         Top             =   0
         Width           =   8895
      End
      Begin VB.Frame Frame1 
         BackColor       =   &H80000009&
         Caption         =   "说明"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   15
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FF8080&
         Height          =   4455
         Left            =   3480
         TabIndex        =   6
         Top             =   1080
         Width           =   5175
         Begin VB.Label Label1 
            BackColor       =   &H80000009&
            Caption         =   $"FirForm.frx":15249
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   3615
            Left            =   360
            TabIndex        =   7
            Top             =   480
            Width           =   4335
         End
      End
   End
End
Attribute VB_Name = "firform"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private 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
Private 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
Private 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

Private r As Long
Private entry As String
Private iniPath As String
Function GetFromINI(AppName As String, KeyName As String, Filename As String) As String
   Dim RetStr As String
   RetStr = String(255, Chr(0))
   GetFromINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), Filename))
End Function

Private Sub Command1_Click()
With Inet1
        .URL = "ftp://134.224.52.105/tomcat/webapps/sgsdata/wsda/"
        .UserName = "sgs"
        .Password = "sgsadmin_arc"
        .OpenURL
        MsgBox Inet1.ResponseCode
        .Execute "SEND D:\发文.doc"
        Do While Inet1.StillExecuting
DoEvents
Loop
'MsgBox "上传完毕!", vbInformation, "提示"

        'wddoc.SaveAs (strYWDiskPath + doc.GetItemValue("DocID")(0) + "(yj).doc")  '另存为一个文档
  
    End With
End Sub

Private Sub Command2_Click()
  iniPath$ = App.path + "\oa.ini"
  MsgBox GetFromINI("SYSTEM", "wsdaView", iniPath)
  MsgBox InputBox("输入修改的值")
  '  entry$ = Text1.Text
  '  r = WritePrivateProfileString("注册信息", "序列号", entry, iniPath)
  '  If r <> 1 Then MsgBox "写序列号出错！"
  
End Sub

Private Sub Command3_Click()
frmTmpSw.Show
End Sub

Private Sub Command4_Click()
frmTmpFw.Show
End Sub

Private Sub Command5_Click()
If MsgBox("你想导入OA 文书档案 数据吗？" & Chr(13) & " 确定后请等待....,否则取消退出.", vbQuestion + vbOKCancel, "信息") = vbCancel Then Exit Sub
frmTmpWsda.Show
End Sub

Private Sub Command6_Click()
Unload Me

End Sub