c1.cls

asp+sql2000做的oa软件＋vb制作的组件源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "c1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Dim myQuot
Dim String1, String2, dbServer, apPath
Private Cnn As New ADODB.Connection
Public workgroup_name, project_name, looktype, userdept As String
Public myYear, myMonth, myDate As String

Public Function MonthlyCal(username, superior)
   Dim ThisMonthFirday, NextMonthFirday, TotalDays, FirdayWeek
   Dim i, j
   If myDate = "" Then myDate = DateTime.Date
   If myYear = "" Then myYear = CStr(DateTime.Year(myDate))
   If myMonth = "" Then myMonth = CStr(DateTime.Month(myDate))
   
   ThisMonthFirday = myYear & "-" & myMonth & "-1" '当月一日
   NextMonthFirday = DateAdd("m", 1, ThisMonthFirday) '下个月一日
   TotalDays = DateDiff("d", ThisMonthFirday, NextMonthFirday) '间隔天数
   FirdayWeek = Weekday(ThisMonthFirday)         '这个月第一天是星期几
   
   MonthlyCal = "<center><table border=1 cellpadding=" & myQuot & "0" & myQuot & " cellspacing=" & myQuot & "5" & myQuot & " bordercolorlight=" & myQuot & "#008000" & myQuot & " bordercolordark=" & myQuot & "#800000" & myQuot & " width=95% class=" & myQuot & "calender" & myQuot & "><tr bgcolor=" & myQuot & "#66aa77" & myQuot & "><td align=center width=" & myQuot & "14%" & myQuot & " height=" & myQuot & "30" & myQuot & ">星期日</td><td align=center width=" & myQuot & "14%" & myQuot & ">星期一</td><td align=center width=" & myQuot & "14%" & myQuot & ">星期二</td><td align=center width=" & myQuot & "14%" & myQuot & ">星期三</td><td align=center width=" & myQuot & "14%" & myQuot & ">星期四</td><td align=center width=" & myQuot & "14%" & myQuot & ">星期五</td><td align=center width=" & myQuot & "14%" & myQuot & ">星期六</td></tr>"
   
   For i = 1 To 7                               '本月第一天
      If FirdayWeek = i Then
         String1 = "<tr>"
         j = 1
         Do While j < i
            String1 = String1 & "<td height=25>&nbsp;</td>"
            j = j + 1
         Loop
         If FirdayWeek = 1 Or FirdayWeek = 7 Then '星期日或星期六
            If CDate(ThisMonthFirday) = CDate(myDate) Then
               String1 = String1 & "<td valign=top align=center class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=" & myQuot & "#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(ThisMonthFirday, username) & "</td>"
            Else
               String1 = String1 & "<td valign=top align=center bgcolor=" & myQuot & "#cccccc" & myQuot & ">" & DisplaySmallWorkRec(ThisMonthFirday, username) & "</td>"
            End If
         Else
            If CDate(ThisMonthFirday) = CDate(myDate) Then
               String1 = String1 & "<td valign=top align=center class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=" & myQuot & "#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(ThisMonthFirday, username) & "</td>"
            Else
               String1 = String1 & "<td valign=top align=center>" & DisplaySmallWorkRec(ThisMonthFirday, username) & "</td>"
            End If
         End If
      End If
   Next
   If FirdayWeek = 7 Then String1 = String1 & "</tr>"
   MonthlyCal = MonthlyCal & String1
   
   For i = 2 To TotalDays - 1                      '本月第二天到本月倒数第二天
      If Weekday(myYear & "-" & myMonth & "-" & i) = 1 Then
         If CDate(myYear & "-" & myMonth & "-" & i) = CDate(myDate) Then
            MonthlyCal = MonthlyCal & "<tr><td valign=top align=center height=25 class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=" & myQuot & "#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & i, username) & "</td>"
         Else
            MonthlyCal = MonthlyCal & "<tr><td valign=top align=center bgcolor='#cccccc' height=25>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & i, username) & "</td>"
         End If
      End If
      If Weekday(myYear & "-" & myMonth & "-" & i) = 7 Then
         If CDate(myYear & "-" & myMonth & "-" & i) = CDate(myDate) Then
            MonthlyCal = MonthlyCal & "<td valign=top align=center height=25 class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=" & myQuot & "#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & i, username) & "</td></tr>"
         Else
            MonthlyCal = MonthlyCal & "<td valign=top align=center bgcolor=" & myQuot & "#cccccc" & myQuot & " height=25>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & i, username) & "</td></tr>"
         End If
      End If
      If Weekday(myYear & "-" & myMonth & "-" & i) <> 7 And Weekday(myYear & "-" & myMonth & "-" & i) <> 1 Then
         If CDate(myYear & "-" & myMonth & "-" & i) = CDate(myDate) Then
            MonthlyCal = MonthlyCal & "<td valign=top align=center height=25 class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=""#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & i, username) & "</td>"
         Else
            MonthlyCal = MonthlyCal & "<td valign=top align=center  height=25>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & i, username) & "</td>"
         End If
      End If
   Next
   
   For i = 1 To 7                                  '本月最后一天
      If Weekday(myYear & "-" & myMonth & "-" & TotalDays) = i Then
         If Weekday(myYear & "-" & myMonth & "-" & TotalDays) = 1 Or Weekday(myYear & "-" & myMonth & "-" & TotalDays) = 7 Then
            If CDate(myYear & "-" & myMonth & "-" & TotalDays) = CDate(myDate) Then
               String2 = "<td valign=top align=center height=25 class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=" & myQuot & "#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & TotalDays, username) & "</td>"
            Else
               String2 = "<td valign=top align=center bgcolor=" & myQuot & "#cccccc" & myQuot & " height=25>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & TotalDays, username) & "</td>"
            End If
         Else
            If CDate(myYear & "-" & myMonth & "-" & TotalDays) = CDate(myDate) Then
               String2 = "<td valign=top align=center height=25 class=" & myQuot & "curday" & myQuot & " style=" & myQuot & "BACKGROUND-COLOR: #800000" & myQuot & " bordercolor=" & myQuot & "#ff0000" & myQuot & " title=祝您今天过得愉快!>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & TotalDays, username) & "</td>"
            Else
               String2 = "<td valign=top align=center  height=25>" & DisplaySmallWorkRec(myYear & "-" & myMonth & "-" & TotalDays, username) & "</td>"
            End If
         End If
         j = 7
         Do While j > i
            String2 = String2 & "<td height=25>&nbsp;</td>"
            j = j - 1
         Loop
         String2 = String2 & "</tr>"
      End If
   Next
   If Weekday(myYear & "-" & myMonth & "-" & TotalDays) = 1 Then String2 = "<tr>" & String2
   MonthlyCal = MonthlyCal & String2 & "</table></center><br>"
End Function

Private Function DisplaySmallWorkRec(myday, username)
   Dim tmpweek, i, sqls, impDegree, iFinished
   i = 1
   tmpweek = Day(myday)
   If CDate(myday) = CDate(myDate) Then
      DisplaySmallWorkRec = "<a href=" & myQuot & "addworkrep.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=white>" & tmpweek & "</font></a>"
   Else
      DisplaySmallWorkRec = "<a href=" & myQuot & "addworkrep.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & ">" & tmpweek & "</a>"
   End If
   If Cnn.State = 1 Then
      Dim trst As New ADODB.Recordset
      trst.ActiveConnection = Cnn
      sqls = "select * from workplan where recdate='" & myday & "' and username='" & username & "'"
      trst.Open sqls
      While Not trst.EOF And Not trst.BOF
         impDegree = trst.Fields("imp")
         iFinished = trst.Fields("finished")
         If impDegree = "no" And iFinished = "no" Then
            If CDate(myday) = CDate(myDate) Then
               DisplaySmallWorkRec = DisplaySmallWorkRec & "<br>" & i & ".<a href=" & myQuot & "displayworkrec.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=white>" & trst.Fields("title") & "</font></a>"
            Else
               DisplaySmallWorkRec = DisplaySmallWorkRec & "<br>" & i & ".<a href=" & myQuot & "displayworkrec.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=black>" & trst.Fields("title") & "</font></a>"
            End If
         End If
         If impDegree = "no" And iFinished = "yes" Then DisplaySmallWorkRec = DisplaySmallWorkRec & "<br>" & i & ".<a href=" & myQuot & "displayworkrec.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=blue>" & trst.Fields("title") & "</font></a>"
         If impDegree = "yes" And iFinished = "no" Then DisplaySmallWorkRec = DisplaySmallWorkRec & "<br>" & i & ".<a href=" & myQuot & "displayworkrec.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=red>" & trst.Fields("title") & "</font></a>"
         If impDegree = "yes" And iFinished = "yes" Then
            If CDate(myday) = CDate(myDate) Then
               DisplaySmallWorkRec = DisplaySmallWorkRec & "<br>" & i & ".<a href=" & myQuot & "displayworkrec.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=#33ff33>" & trst.Fields("title") & "</font></a>"
            Else
               DisplaySmallWorkRec = DisplaySmallWorkRec & "<br>" & i & ".<a href=" & myQuot & "displayworkrec.asp?username=" & username & "&recdate=" & myday & "&workgroup_name=" & workgroup_name & "&project_name=" & project_name & "&looktype=" & looktype & "&userdept=" & userdept & myQuot & "><font color=#cc0000>" & trst.Fields("title") & "</font></a>"
            End If
         End If
         i = i + 1
         trst.MoveNext
      Wend
      Set trst = Nothing
   End If
End Function

Private Sub Class_Initialize()
   myQuot = Chr(34)
   apPath = App.Path
   Open apPath & "\curdbinf.xgk" For Input As #1
   Input #1, dbServer
   Close #1
   
   Cnn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;password=75316427;Initial Catalog=shaowuoffice;Data Source=" & Trim(dbServer)
   Cnn.ConnectionTimeout = 30
   Cnn.Open
End Sub

Private Sub Class_Terminate()
   Cnn.Close
   Set Cnn = Nothing
End Sub