commmodu.bas

用于电子行业打印复杂报表格式和不干胶标签

Attribute VB_Name = "CommModu"
Option Explicit
Option Base 0   '将缺省的数组下标设为 0

Public fMainForm As frmMain
Public SystemDir As String    '储存系统的缺省目录，如 C:\OrganMis
Public UserName, UserDepart, UserRole As String   '记录当前使用者名称，部门，角色
Public strConn, strQuery, scrwConn, hbConn As String  '定义SQL语句的连接字符串和查询字符串
Public varMark As Variant     '用于记录修改时用的 BookMark
Public tabname As String      '储存查找用的表名
Public moduledex As Integer   '用于记下模块数,储存拼接序号
Public prnflag As String  '记录是否打印安标
Public commpapersize, bgjpapersize As Integer '记录打印机纸张类型
Public pubabheight, pubabpercent As Variant '设定打印安标时的高度，以毫米为单位 ，设定安标的缩放百分比

Public cnSys, cnSysscrw, cnSyshb As ADODB.Connection  '连接字符串
Public rsAll, rsPrint As ADODB.Recordset   '储存全程记录、打印结果
Public pcpath As String '安标路径
Public lotnoflag As Integer '用于判断是否显示年份 为 1 时显示，为 0 时不显示

'标签打印相关变量
Public stunit As Variant '1毫米等于多少
'记录CARTRIDGE FUSE LINK相关变量
Public pubpnstr, typestr, ratistr, breastr, capastr, qntystr, datestr, lotnstr, inspstr, otherstr, otherab As String
'Public picthc0, picthc1, picthc2, picthc3, picthc4, picthc5, picthc6, picthc7, picthc8, picthc9 As String
Public picarray(14) As String  '保存 cartridge fuse link 安标名
Public picnum, picwidth, picjj, picleft, pictop, picleft2, pictop2, piclefttmp, pictoptmp, picleft2tmp, pictop2tmp As Variant '保存安标数、安标宽度、安标间距、安标起始位置left top
Public printnum, printflag As Integer '打印数量
Public pubhnwstr As String  '保存盒内外

'记录 MINIATURE FUSE　标签相关变量
Public mpicarray(14) As String  '保存 miniture fuse 安标名
Public mpnstr, mtypestr, mratistr, minterstr, mrating, mqntystr, mdatestr, mlotnstr, minspstr, motherstr, motherab As String
Public mpicnum, mpicwidth, mpicjj, mpicleft, mpictop, mpicleft2, mpictop2, mpiclefttmp, mpictoptmp, mpicleft2tmp, mpictop2tmp As Variant '保存安标数、安标宽度、安标间距、安标起始位置left top
Public mprintnum, mprintflag, addrddlflag As Integer '打印数量 打印标志　增加熔断电流标志
Public pnwidth As Variant '记录PN号的长度 2006.06.24 add the code

'记录 日本　标签相关变量
Public jpicarray(14) As String  '保存　日本　安标名
Public jpnstr, jtypestr, jratistr, jinterstr, jqntystr, jdatestr, jlotnstr, jinspstr, jotherstr, jotherab As String
Public jpicnum, jpicjj, jpicleft, jpictop, jpicleft2, jpictop2, jpiclefttmp, jpictoptmp, jpicleft2tmp, jpictop2tmp As Variant '保存安标数、安标宽度、安标间距、安标起始位置left top
Public jprintnum, jprintflag As Integer '打印数量

'记录 5#　标签相关变量
Public camabarray(14) As String  '保存　5#　安标名
Public camab, campn, camtype, camratings, camqty, camlotno, camdate As String
Public camprint, camprintflag, camflag, camabnum As Integer '打印数量 打印标志　是否显示'RoHS PRODUCT' 安标个数

'记录 6#　标签相关变量
Public bq6habarray(14) As String '保存　6#　安标名
Public bq6htype, bq6hcc, bq6hratings, bq6hab, bq6hqty, bq6hinterrupting, bq6hrating, bq6hpn, bq6hlotno, bq6hother As String
Public bq6hprint, bq6hprintflag, bq6habnum As Integer '打印数量 打印标志 安标个数
Public bq6h2 As String   '2φCAMDEN标签的时间
Public cam6hflag As Integer '是否显示'RoHS PRODUCT' '1'显示

'记录 无铅 非标　标签相关变量
Public wqarray(14) As String
Public wqtype, wqcc, wqratings, wqab, wqqty, wqlotno, wqother, wqpn As String
Public wqprint, wqprintflag, wqabnum As Integer  '打印数量 打印标志 安标个数
Public wqccflag As Integer '是否显示尺寸和FUSE  0显示　1不显示
Public wq110flag As String '记录无铅标签110%标志

'记录  5R、5E系列　标签相关变量
Public wxlarray(14) As String
Public wxlab, wxlpn, wxltype, wxlratings, wxlqty, wxllotno, wxldate As String
Public wxlprint, wxlprintflag, wxlabnum As Integer '打印数量 打印标志 安标个数
Public wxlprflag, wxlslflag As Integer '判断是否显示RoHS PRODUCT   0显示　1不显示   是否显示　Short Leads

Public pubiec, pubul, pubpse As String '保存分断电流安标系列分类 2006.07.10 add
Public pubwagiec, pubwagpse As String '保存无安规时，相关的型号 2006.07.11 add
Public pubrdtxxl As String '保存熔断特性系列

'应用于 SQL 语句的连接字符串的写法
'Public Const strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=OrganTest;Data Source=cic_sqlserver"

'函数说明
Public Declare Function GetVolumeInformation Lib "kernel32" _
  Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
  ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
  lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
  lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
  ByVal nFileSystemNameSize As Long) As Long
Public Declare Function GetPrivateProfileInt Lib "kernel32.dll" Alias "GetPrivateProfileIntA" (ByVal lpapplicationname _
   As String, ByVal lpkeyname As String, ByVal nDefault As Long, ByVal lpfilename As String) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias "GetPrivateProfileStringA" (ByVal lpapplicationname _
   As String, ByVal lpkeyname As String, ByVal lpdefault As String, ByVal lpreturnedstring As String, ByVal nSize _
   As Long, ByVal lpfilename As String) As Long
   

Sub Main()
  Dim fLogin As New frmLogin
  Dim syspath As String
  Dim conn1, conn2, conn3, xl1, xl2, xl3, wag1, wag2, rdtx1 As Long
  Dim conn1str As String
  Dim conn2str As String
  Dim conn3str As String
  Dim xlstr1 As String
  Dim xlstr2 As String
  Dim xlstr3 As String
  Dim wagstr1 As String
  Dim wagstr2 As String
  Dim rdtxstr As String
  'Dim printpath As String

  SystemDir = App.Path
  pcpath = SystemDir & "\picture\"
  syspath = SystemDir & "\setparam.ini"
  
   '获取打印机纸张类型
  'printpath = ""
  'printpath = SystemDir & "\setparam.ini"
  'commpapersize = GetPrivateProfileInt("prnpapersize", "commsize", 9, printpath)
  'bgjpapersize = GetPrivateProfileInt("prnpapersize", "bgjsize", 126, printpath)
  
  '在此获得数据库连接字符串
  conn1str = Space$(255)
  conn2str = Space$(255)
  conn3str = Space$(255)
 
  conn1 = GetPrivateProfileString("sqlserverconn", "sqlink", "Default", conn1str, 255, syspath)
  conn2 = GetPrivateProfileString("accessconn", "scrwlink", "Default", conn2str, 255, syspath)
  conn3 = GetPrivateProfileString("accessconn", "hblink", "Default", conn3str, 255, syspath)
  
  If conn1 <> 0 Then strConn = Left$(conn1str, conn1)
  If conn2 <> 0 Then scrwConn = Left$(conn2str, conn2)
  If conn3 <> 0 Then hbConn = Left$(conn3str, conn3)
  
 '2006.07.10 add the code  ***************************
  xlstr1 = "": xlstr2 = "": xlstr3 = ""
  xlstr1 = Space$(255)
  xlstr2 = Space$(255)
  xlstr3 = Space$(255)
 
  xl1 = GetPrivateProfileString("fddlxl", "iecxl", "Default", xlstr1, 255, syspath)
  xl2 = GetPrivateProfileString("fddlxl", "ulxl", "Default", xlstr2, 255, syspath)
  xl3 = GetPrivateProfileString("fddlxl", "psexl", "Default", xlstr3, 255, syspath)
  
  If xl1 <> 0 Then pubiec = Left$(xlstr1, xl1)
  If xl2 <> 0 Then pubul = Left$(xlstr2, xl2)
  If xl3 <> 0 Then pubpse = Left$(xlstr3, xl3)
 '**************************************************
 
 '2006.07.11 add the code  ***************************
  wagstr1 = "": wagstr2 = ""
  wagstr1 = Space$(255)
  wagstr2 = Space$(255)
 
  wag1 = GetPrivateProfileString("wagxh", "wagiec", "Default", wagstr1, 255, syspath)
  wag2 = GetPrivateProfileString("wagxh", "wagpse", "Default", wagstr2, 255, syspath)
  
  If wag1 <> 0 Then pubwagiec = Left$(wagstr1, wag1)
  If wag2 <> 0 Then pubwagpse = Left$(wagstr2, wag2)
 '**************************************************
 
 '2006.07.11 add the code  ***************************
  rdtxstr = ""
  rdtxstr = Space$(255)
  rdtx1 = GetPrivateProfileString("rdtx", "rdtxxl", "Default", rdtxstr, 255, syspath)
  If rdtx1 <> 0 Then pubrdtxxl = Left$(rdtxstr, rdtx1)
 '**************************************************
 
  'Open SystemDir & "\SqlConn.txt" For Input As #1    '将数据从文件读出
  'Do While Not EOF(1)
  '  Input #1, strConn
 '  Loop
  'Close #1
  
  Set cnSys = New ADODB.Connection   '初始化系统连接
  cnSys.CursorLocation = adUseClient
  cnSys.Open strConn
  
  Set cnSysscrw = New ADODB.Connection
  cnSysscrw.CursorLocation = adUseClient
  cnSysscrw.Open scrwConn
  
  Set cnSyshb = New ADODB.Connection
  cnSyshb.CursorLocation = adUseClient
  cnSyshb.Open hbConn
    
  fLogin.Show vbModal  '登录框必须模态显示
  If Not fLogin.OK Then
    '登录失败，退出应用程序
    cnSys.Close
    Set cnSys = Nothing
    End
  End If
  Unload fLogin
   stunit = 56.87 '1毫米等于56.87
  Set fMainForm = New frmMain
  fMainForm.Show
End Sub
'**将字段的空白部分去掉
Public Function vFldVal(vntFldVal As Variant) As Variant
  If IsNull(vntFldVal) Or IsEmpty(vntFldVal) Then
    vFldVal = ""
  Else
    vFldVal = CStr(Trim(vntFldVal))
  End If
End Function

Public Function ParseString(StringToParse As String, _
    Optional Delimiter As String = " ") As Collection
    
    Dim colTemp     As Collection
  '  Dim objWord     As Word
    
    Dim lngStartPos As Long
    Dim lngNextPos  As Long
    
    Dim strTemp     As String
    
    ' Initialize the StartPosition and the Collection
    lngStartPos = 1
    Set colTemp = New Collection
    
    Do
        ' Clear any reference to a previous word