VERSION 5.00 Object = "{8767A745-088E-4CA6-8594-073D6D2DE57A}#9.2#0"; "crviewer9.dll" Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx" Begin VB.Form check_receive Caption = "ตรวจสอบการรับวารสาร" ClientHeight = 8295 ClientLeft = 60 ClientTop = 450 ClientWidth = 11880 LinkTopic = "Form1" MDIChild = -1 'True ScaleHeight = 8295 ScaleWidth = 11880 WindowState = 2 'Maximized Begin CRVIEWER9LibCtl.CRViewer9 CRViewer Height = 9975 Left = 120 TabIndex = 14 Top = 120 Visible = 0 'False Width = 14535 lastProp = 500 _cx = 25638 _cy = 17595 DisplayGroupTree= 0 'False DisplayToolbar = -1 'True EnableGroupTree = -1 'True EnableNavigationControls= -1 'True EnableStopButton= -1 'True EnablePrintButton= -1 'True EnableZoomControl= 0 'False EnableCloseButton= -1 'True EnableProgressControl= -1 'True EnableSearchControl= -1 'True EnableRefreshButton= -1 'True EnableDrillDown = -1 'True EnableAnimationControl= -1 'True EnableSelectExpertButton= 0 'False EnableToolbar = -1 'True DisplayBorder = -1 'True DisplayTabs = 0 'False DisplayBackgroundEdge= -1 'True SelectionFormula= "" EnablePopupMenu = -1 'True EnableExportButton= -1 'True EnableSearchExpertButton= 0 'False EnableHelpButton= 0 'False LaunchHTTPHyperlinksInNewBrowser= -1 'True End Begin VB.Frame Frame1 BackColor = &H00C0E0FF& Caption = "กำหนดช่วงเวลาที่ต้องการตรวจสอบ" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 3975 Left = 1680 TabIndex = 0 Top = 1200 Width = 7095 Begin MSComCtl2.MonthView MonthView1 Height = 2370 Left = 120 TabIndex = 5 Top = 1320 Visible = 0 'False Width = 2490 _ExtentX = 4392 _ExtentY = 4180 _Version = 393216 ForeColor = -2147483630 BackColor = 14737632 Appearance = 1 MonthBackColor = 12648447 StartOfWeek = 78249986 TitleBackColor = 16711680 TitleForeColor = 16777215 CurrentDate = 38971 End Begin MSComCtl2.MonthView MonthView2 Height = 2370 Left = 4080 TabIndex = 6 Top = 1320 Visible = 0 'False Width = 2490 _ExtentX = 4392 _ExtentY = 4180 _Version = 393216 ForeColor = -2147483630 BackColor = -2147483633 Appearance = 1 MonthBackColor = 12648447 StartOfWeek = 78249986 TitleBackColor = 16711680 TitleForeColor = 16777215 CurrentDate = 38971 End Begin VB.CommandButton Command4 Caption = "Exit" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 4200 TabIndex = 10 Top = 2640 Width = 1815 End Begin VB.CommandButton Command3 Caption = "ตรวจสอบ" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 615 Left = 1560 TabIndex = 9 Top = 2640 Width = 1815 End Begin VB.CommandButton Command2 BackColor = &H00FFC0C0& Caption = "..." BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6120 Style = 1 'Graphical TabIndex = 8 Top = 1680 Width = 375 End Begin VB.CommandButton Command1 BackColor = &H00FFC0C0& Caption = "..." BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 3120 Style = 1 'Graphical TabIndex = 7 Top = 1680 Width = 375 End Begin VB.TextBox Text2 Alignment = 2 'Center BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 330 Left = 4560 Locked = -1 'True TabIndex = 2 Top = 1680 Width = 1455 End Begin VB.TextBox Text1 Alignment = 2 'Center BeginProperty Font Name = "MS Sans Serif" Size = 12 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 330 Left = 1560 Locked = -1 'True TabIndex = 1 Top = 1680 Width = 1455 End Begin VB.Frame Frame2 BackColor = &H00C0FFC0& Caption = "เลือกประเภท" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00004000& Height = 855 Left = 1560 TabIndex = 11 Top = 480 Width = 4335 Begin VB.OptionButton Option2 BackColor = &H00C0FFC0& Caption = "ภาษาต่างประเทศ" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 375 Left = 2280 TabIndex = 13 Top = 360 Width = 1935 End Begin VB.OptionButton Option1 BackColor = &H00C0FFC0& Caption = "ภาษาไทย" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00800000& Height = 375 Left = 480 TabIndex = 12 Top = 360 Width = 1215 End End Begin VB.Label Label2 BackColor = &H00C0E0FF& Caption = "ถึงวันที่" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 255 Left = 3720 TabIndex = 4 Top = 1680 Width = 615 End Begin VB.Label Label1 BackColor = &H00C0E0FF& Caption = "ตั้งแต่วันที่" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 222 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00C00000& Height = 255 Left = 600 TabIndex = 3 Top = 1680 Width = 855 End End End Attribute VB_Name = "check_receive" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim Conn As New ADODB.Connection Dim magtb As New ADODB.Recordset Dim receivetb As New ADODB.Recordset Dim s_date, e_date, s_date1, e_date1 As Date Dim pasa_jour As String Private Sub Command1_Click() MonthView1.Visible = True End Sub Private Sub Command2_Click() MonthView2.Visible = True End Sub Private Sub Command3_Click() Dim crystal As CRAXDRT.Application 'LOADS REPORT FROM FILE Dim Report As CRAXDRT.Report 'HOLDS REPOR Set crystal = New CRAXDRT.Application 'MANAGES REPORTS Dim rs As New ADODB.Recordset Dim be_trantb As New ADODB.Recordset Dim m_magPointer, m_magName, m_magType, check_type As String Dim f_date, b_date As Date Dim count_time, count_comp As Integer If Option1.Value = True Or Option2.Value = True Then check_type = "02 03 04 05 06 07 08 09" b_date = s_date1 Set magtb = New ADODB.Recordset With magtb If .State = adStateOpen Then .Close .CursorLocation = adUseClient .Open "Select Pointer,Magazine_Name,MagType_code From magazine where Receive_Code='1' and left(pointer,1)='" & pasa_jour & "' order by MagType_Code", Conn, adOpenForwardOnly, adLockReadOnly If Not .EOF Then menumagizine.StatusBar1.Panels(1).Text = .RecordCount .MoveFirst End If count_comp = 0 Do While Not .EOF m_magPointer = .Fields(0).Value m_magName = .Fields(1).Value m_magType = .Fields(2).Value count_time = 0 'คำนวณวัน ที่ได้รับวารสาร ย้อนหลัง 1 ฉบับ If InStr(check_type, m_magType) <> 0 Then Do While True Select Case m_magType Case "01" f_date = calulate_date_bef("D", 1, b_date) Case "02" f_date = calulate_date_bef("D", 7, b_date) Case "03" f_date = calulate_date_bef("W", 0, b_date) Case "04" f_date = calulate_date_bef("M", 1, b_date) Case "05" f_date = calulate_date_bef("M", 2, b_date) Case "06" f_date = calulate_date_bef("M", 3, b_date) Case "07" f_date = calulate_date_bef("M", 4, b_date) Case "08" f_date = calulate_date_bef("M", 6, b_date) Case "09" f_date = calulate_date_bef("Y", 1, b_date) End Select count_time = count_time + 1 If count_time = 3 Then Exit Do 'ตรวจสอบการรับวารสารฉบับก่อนหน้า Set be_trantb = New ADODB.Recordset If be_trantb.State = adStateOpen Then be_trantb.Close be_trantb.CursorLocation = adUseClient be_trantb.Open "Select daily From tranfile where pointer='" & m_magPointer & "' and daily between '" & Year(f_date) & Right(Format(f_date, "YYYY-MM-DD"), 6) & "' and '" & Year(s_date1) & Right(Format(s_date1, "YYYY-MM-DD"), 6) & "' order by daily", Conn, adOpenForwardOnly, adLockReadOnly If Not be_trantb.EOF Then Call cal_receive(m_magPointer, m_magName, m_magType, be_trantb.Fields(0).Value) b_date = s_date1 Exit Do Else b_date = f_date End If be_trantb.Close Set be_trantb = Nothing Loop count_comp = count_comp + 1 End If menumagizine.StatusBar1.Panels(2).Text = count_comp .MoveNext Loop End With magtb.Close menumagizine.StatusBar1.Panels(1).Text = " " menumagizine.StatusBar1.Panels(2).Text = " " Set magtb = Nothing MsgBox "การประมวลผลข้อมูล เสร็จเรียบร้อยแล้ว" Set rs = New ADODB.Recordset rs.Open "SELECT * From chk_receive", Conn, adOpenForwardOnly, adLockReadOnly If rs.RecordCount > 0 Then CRViewer.EnableCloseButton = False Set Report = crystal.OpenReport(App.Path & "\receive_check.rpt") 'OPEN OUR REPORT Report.DiscardSavedData 'CLEARS REPORT SO WE WORK FROM RECORDSET Report.Database.SetDataSource rs 'LINK REPORT TO RECORDSET CRViewer.ReportSource = Report 'LINK VIEWER TO REPORT CRViewer.ViewReport 'SHOW REPORT CRViewer.Zoom 94 Set Report = Nothing Else MsgBox "ในช่างเวลาที่กำหนดนี้ได้รับวารสารครบแล้ว" End If End If End Sub Private Sub Command4_Click() Unload Me End Sub Private Sub Form_Load() Set Conn = New ADODB.Connection Conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _ & "SERVER=192.168.1.15;" _ & "DATABASE=magazine;" _ & "UID=chaiya;" _ & "OPTION=" & 1 + 2 + 8 + 32 + 2048 + 16384 Conn.CursorLocation = adUseClient Conn.Mode = adModeUnknown Conn.Open Conn.Execute "delete from chk_receive;" menumagizine.StatusBar1.Panels(1).Width = 2000 menumagizine.StatusBar1.Panels(2).Width = 4000 End Sub Private Sub MonthView1_DateClick(ByVal DateClicked As Date) MonthView1.Visible = False Text1.Text = DateClicked s_date1 = DateClicked s_date = Format(Year(DateClicked) & Right(Format(DateClicked, "YYYY-MM-DD"), 6), "YYYY-MM-DD") If (e_date < s_date) And Not (Text2 = "") Then MsgBox "วันที่ไม่ถูกต้อง กรุณาแก้ไขวันที่ใหม่", vbCritical + vbOKOnly, " Date Error" MonthView1.Visible = True End If End Sub Private Sub MonthView2_DateClick(ByVal DateClicked As Date) MonthView2.Visible = False Text2.Text = DateClicked e_date1 = DateClicked e_date = Format(Year(DateClicked) & Right(Format(DateClicked, "YYYY-MM-DD"), 6), "YYYY-MM-DD") If e_date < s_date Then MsgBox "วันที่ไม่ถูกต้อง กรุณาแก้ไขวันที่ใหม่", vbCritical + vbOKOnly, " Date Error" MonthView2.Visible = True End If End Sub Private Sub cal_receive(ByVal c_magPointer As String, ByVal c_magName As String, ByVal c_magType As String, ByVal c_date As Date) Dim trantb As New ADODB.Recordset Dim f_date As Date Do While True Select Case c_magType Case "01" f_date = calulate_date_next("D", 1, c_date) Case "02" f_date = calulate_date_next("D", 7, c_date) Case "03" f_date = calulate_date_next("W", 0, c_date) Case "04" f_date = calulate_date_next("M", 1, c_date) Case "05" f_date = calulate_date_next("M", 2, c_date) Case "06" f_date = calulate_date_next("M", 3, c_date) Case "07" f_date = calulate_date_next("M", 4, c_date) Case "08" f_date = calulate_date_next("M", 6, c_date) Case "09" f_date = calulate_date_next("Y", 1, c_date) End Select If f_date >= s_date1 And f_date <= e_date1 Then Set trantb = New ADODB.Recordset If trantb.State = adStateOpen Then trantb.Close trantb.CursorLocation = adUseClient trantb.Open "Select Daily,YearNo,ItemsNo,DescriptionItem From tranfile where pointer='" & c_magPointer & "' and Daily ='" & Year(f_date) & Right(Format(f_date, "YYYY-MM-DD"), 6) & "' ", Conn, adOpenForwardOnly, adLockReadOnly Set receivetb = New ADODB.Recordset If receivetb.State = adStateOpen Then receivetb.Close receivetb.CursorLocation = adUseClient receivetb.Open "Select * From chk_receive", Conn, adOpenDynamic, adLockOptimistic If trantb.EOF Then receivetb.AddNew receivetb.Fields(0).Value = c_magName receivetb.Fields(1).Value = convert_date(f_date) receivetb.Fields(2).Value = s_date1 receivetb.Fields(3).Value = e_date1 receivetb.Update End If receivetb.Close Set receivetb = Nothing trantb.Close Set trantb = Nothing c_date = f_date ElseIf f_date < s_date1 Then c_date = f_date Else Exit Do End If Loop End Sub Private Sub Option1_Click() Option2.Value = False pasa_jour = "I" End Sub Private Sub Option2_Click() Option1.Value = False pasa_jour = "J" End Sub