mdlmain.bas

< 飞鸿商品>>零售是基于VB+SQL2000开的商品零售管理系统. 开发的很好.可以一看

Attribute VB_Name = "mdlMain"
Option Explicit

Public Conn As ADODB.Connection
Public ViewStock As Boolean
Public UserName As String
Public SysCaption As String
Public ConnectionStr As String
Public Base As String

Private Sub Main()
Dim Rst As ADODB.Recordset
Dim SQLstring As String
Dim SysBase As String
Dim UID As String
Dim PWD As String

If App.PrevInstance = True Then MsgBox "请不要运行多个程序实例！", 64: Exit Sub
If Dir(App.Path & "\connaction") = "" Then
  MsgBox "数据库连接文件不存在。请重新进行系统初始化！", 64
  Exit Sub
End If

Open App.Path & "\connaction" For Input Shared As #1
  Input #1, SysBase
Close #1

Base = Mid(SysBase, 1, InStr(SysBase, "/") - 1)
SysBase = Mid(SysBase, InStr(SysBase, "/") + 1)
UID = Mid(SysBase, 1, InStr(SysBase, "/") - 1)
PWD = Mid(SysBase, InStr(SysBase, "/") + 1)

ConnectionStr = "Provider=SQLOLEDB.1;Password=" & PWD & ";Persist Security Info=True;" & _
      "User ID=" & UID & ";Initial Catalog="
SQLstring = "Provider=SQLOLEDB.1;Password=" & PWD & ";Persist Security Info=True;" & _
      "User ID=" & UID & ";Initial Catalog=pos;Data Source=" & Base
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
Conn.ConnectionString = SQLstring
Conn.Open

Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open "select syscaption from sysset", Conn, adOpenDynamic, adLockReadOnly, adCmdText
SysCaption = Rst.Fields(0)
Rst.Close
Set Rst = Nothing

FrmFlashIN.Show

End Sub

Public Sub FillGrid(FormatString As String, SQL As String, Grid As MSFlexGrid, GridCol As Integer)

Dim Rst As ADODB.Recordset
Dim I As Integer, J As Integer

On Error GoTo er
Set Rst = New ADODB.Recordset
Rst.CursorLocation = adUseClient
Rst.Open SQL, Conn, adOpenKeyset, adLockReadOnly, adCmdText

Grid.Clear
Grid.Rows = 1
Grid.Cols = GridCol
Grid.FormatString = FormatString
For I = 1 To Rst.RecordCount
  Grid.Rows = Grid.Rows + 1
  For J = 1 To GridCol
    Grid.TextMatrix(Grid.Rows - 1, J - 1) = Rst.Fields(J - 1) & ""
  Next
Rst.MoveNext
Next

Rst.Close
Set Rst = Nothing
SQL = ""
If Grid.Rows = 1 Then MsgBox "您所指定的查询结果为空！", 64
Exit Sub

er:
  MsgBox "查询出现错误，可能由您指定的查询条件不正确！", 16

End Sub