Imports System.Net.NetworkInformation Module Pub Structure s_Project Dim FileName As String Dim MakeTime As String Dim Desc As String Dim Opened As Boolean Dim UIVersion As String Dim LGVersino As String Dim Name As String Dim MaxUI As String Dim MaxLG As String Dim SFType As String '//저장파일 형태 Dim EditTime As String Dim Admin As Boolean '//현재프로그램이 관리자 모드인가? Dim Password As String '//해당프로젝트가 엄호로 보호되어있는가? Dim IsError As Boolean '//로드시 에러가 발생하였는가? Dim CUrIP As String Dim CUrMac As String Dim LoginTime As String '//로그인시간 Dim UserId As String Dim UserName As String Dim UserPass As String Dim UserIp As String Dim UserMac As String Dim UserAuthType As String End Structure Public Enum EProgram 총량평가 친환경평가 End Enum Public Prj As New s_Project : Public StartVersion As String = "2010032000" Public Setting As arUtil.Setting Public Program As EProgram ' Public Uselov As Lov.ModLov Public PreFile(10) As String Public msgf As Frm_Work = Nothing '201130830 Public DSET1 As New DS '//일반데이터 Public DSET2 As New DS '//일반데이터(임시) Public DSETR1 As New DSR '//결과데이터(결과) Public DSETR2 As New DSR '//결과데이터(임시) Public DataDir As New System.IO.DirectoryInfo(My.Application.Info.DirectoryPath) Public TemplateDir As New System.IO.DirectoryInfo(DataDir.FullName & "\template") '//eco2-od Public CalcO As CalculatorOD '//계산로직이다.파일열릴떄 할당됨 Public Result1o As New CResultOD() '//기본데이터결과 Public Log As New System.Text.StringBuilder Public EnDec As New ArinLogin.EnDec("tindevil.com") Public Sub NOTICE(ByVal MSG As String, ByVal Src As Windows.Forms.ToolStripStatusLabel, ByVal FCOLOR As Drawing.Color) If Not Src Is Nothing Then Src.Text = "▶ " & MSG & Space(1) & "[" & Format(Now, "HH시mm분ss초") & "]" Src.ForeColor = FCOLOR End If If FCOLOR = Drawing.Color.Red Then My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Beep) End Sub ''' ''' 인터넷에 연결되었는지를 체크합니다. ''' ''' ''' Public Function CheckInternet() Try Dim myping As New Ping() Dim host As String = "google.com" Dim buffer(31) As Byte Dim timeout As Integer = 1000 Dim pingOpt As New PingOptions() Dim rep As PingReply = myping.Send(host, timeout, buffer, pingOpt) If rep.Status = IPStatus.Success Then Return True Else Return False End If Catch ex As Exception Return False End Try End Function Public Sub ClearfGridColWidth(grid As C1.Win.C1FlexGrid.C1FlexGrid) For i As Integer = 0 To grid.Cols.Count - 1 If Not grid.Cols(i).Visible Then Continue For grid.Cols(i).Width = -1 Next End Sub Public Sub SavefGridColWidth(fName As String, grid As C1.Win.C1FlexGrid.C1FlexGrid) Dim keyname As String = fName + "_" + grid.Name If Pub.Program = EProgram.친환경평가 Then keyname = fName + "_1_" + grid.Name End If For i As Integer = 0 To grid.Cols.Count - 1 If Not grid.Cols(i).Visible Then Continue For If String.IsNullOrEmpty(grid.Cols(i).Name) Then Continue For Pub.Setting.Data(keyname, grid.Cols(i).Name) = grid.Cols(i).Width Next End Sub Public Sub ReadfGridColWidth(fName As String, grid As C1.Win.C1FlexGrid.C1FlexGrid) Dim keyname As String = fName + "_" + grid.Name If Pub.Program = EProgram.친환경평가 Then keyname = fName + "_1_" + grid.Name End If For i As Integer = 0 To grid.Cols.Count - 1 If Not grid.Cols(i).Visible Then Continue For If String.IsNullOrEmpty(grid.Cols(i).Name) Then Continue For Dim wid As String = Pub.Setting.Data(keyname, grid.Cols(i).Name, "-1") grid.Cols(i).Width = Integer.Parse(wid) Next End Sub Public Function getColCaption(ByVal dt As DataTable) As String() Dim Clist(dt.Columns.Count - 1) As String For i As Integer = 1 To dt.Columns.Count If dt.Columns(i - 1).Caption.ToString <> "" Then Clist(i - 1) = dt.Columns(i - 1).Caption.ToString Next Return Clist End Function Public Function getColName(ByVal dt As DataTable) As String() Dim Clist(dt.Columns.Count - 1) As String For i As Integer = 1 To dt.Columns.Count If dt.Columns(i - 1).ColumnName.ToString <> "" Then Clist(i - 1) = dt.Columns(i - 1).ColumnName.ToString Next Return Clist End Function Public Function STB(ByVal src As String) As Byte() Return System.Text.Encoding.Default.GetBytes(src) End Function Public Function STB(ByVal src As Byte()) As String Return System.Text.Encoding.Default.GetString(src) End Function '''공용코드의코드반환 Public Function Get_CCode(ByVal gubun As String, ByVal name As String) As String Dim DR() As DS.tbl_common_odRow = CType(DSET1.tbl_common_od.Select("gubun='" & gubun & "' and name='" & name & "'"), DS.tbl_common_odRow()) If DR.GetUpperBound(0) = -1 Then Return "" Return DR(0).code End Function '''공용코드의이름반환 Public Function Get_CName(ByVal gubun As String, ByVal code As String) As String Dim DR() As DS.tbl_common_odRow = CType(DSET1.tbl_common_od.Select("gubun='" & gubun & "' and code='" & code & "'"), DS.tbl_common_odRow()) If DR.GetUpperBound(0) = -1 Then Return "" Return DR(0).name End Function Public Function NVL(ByVal src As Object, Optional ByVal DefVal As Object = "") As Object Try If src.ToString = "" Or src Is DBNull.Value Then Return DefVal Else Return src End If Catch ex As Exception Return DefVal End Try End Function Public Sub Read_CommonCode_OD(Optional ByVal Version As String = "") Work_msg("공용코드 확인중") If Version = "" Then Dim L As New ArinLogin.ArinLOgin Dim VersionInfo As ArinLogin.ArinLOgin.sVersionInfo = Nothing VersionInfo = L.Get_LastVersion("CO") '//버젼을 가져오는데 eco 버젼만 가져오게 바꺼야겟죵 ^^ 구분자를 넣도록 합시닷! Version = VersionInfo.Ver End If Try Dim TaC As New DSTableAdapters.tbl_common_odTableAdapter TaC.Fill(DSET1.tbl_common_od) 'DSET1.tbl_common_od.Clear() 'DSET1.tbl_common_od.AcceptChanges() 'DSET1.tbl_common_od.Merge(DSET1.tbl_common_od) 'DSET1.tbl_common_od.Clear() DSET1.tbl_common_od.AcceptChanges() DSET1.tbl_Desc.Rows(0)("versionc") = Version DSET1.AcceptChanges() Catch ex As Exception MsgBox("공용코드 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") End Try 'MsgBox(Version) Work_msg("") End Sub Public Sub Read_Profile_OD(Optional ByVal Version As String = "") Work_msg("표준프로파일(OD) 확인중") If Version = "" Then Dim L As New ArinLogin.ArinLOgin Dim VersionInfo As ArinLogin.ArinLOgin.sVersionInfo = Nothing VersionInfo = L.Get_LastVersion("PO") '//버젼을 가져오는데 eco 버젼만 가져오게 바꺼야겟죵 ^^ 구분자를 넣도록 합시닷! Version = VersionInfo.Ver End If Try Dim TaC As New DSTableAdapters.tbl_profile_odTableAdapter TaC.Fill(DSET1.tbl_profile_od) 'DSET1.tbl_profile_od.Clear() 'DSET1.tbl_profile_od.AcceptChanges() 'DSET1.tbl_profile_od.Merge(DSET1.tbl_profile_od) 'DSET1.tbl_profile_od.Clear() DSET1.tbl_profile_od.AcceptChanges() DSET1.tbl_Desc.Rows(0)("versionp") = Version DSET1.AcceptChanges() Catch ex As Exception MsgBox("표준프로파일(OD) 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") End Try 'MsgBox(Version) Work_msg("") End Sub Public Sub Read_WatherGroup() DSET1.weather_group.Clear() DSET1.weather_group.AcceptChanges() Try Dim TaC As New DSTableAdapters.weather_groupTableAdapter TaC.Fill(DSET1.weather_group) Catch ex As Exception MsgBox("기상데이터(그룹) 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") End Try End Sub Public Sub Read_WeatherData_OD(Optional ByVal Version As String = "") Work_msg("기상데이터 확인중") Dim Iserror As Boolean = False If Version = "" Then Dim L As New ArinLogin.ArinLOgin Dim VersionInfo As ArinLogin.ArinLOgin.sVersionInfo = Nothing VersionInfo = L.Get_LastVersion("W") '//버젼을 가져오는데 eco 버젼만 가져오게 바꺼야겟죵 ^^ 구분자를 넣도록 합시닷! Version = VersionInfo.Ver End If DSET1.tbl_weather_od.Clear() DSET1.weather_cha_od.Clear() DSET1.weather_ilsa_od.Clear() DSET1.weather_temp_od.Clear() DSET1.weather_supdo_od.Clear() DSET1.AcceptChanges() Try Dim TaC As New DSTableAdapters.tbl_weather_odTableAdapter TaC.Fill(DSET1.tbl_weather_od) Catch ex As Exception MsgBox("기상데이터0 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") Iserror = True End Try Try Dim TaC As New DSTableAdapters.weather_cha_odTableAdapter TaC.Fill(DSET1.weather_cha_od) Catch ex As Exception MsgBox("기상데이터1 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") Iserror = True End Try Try Dim TaC As New DSTableAdapters.weather_ilsa_odTableAdapter TaC.Fill(DSET1.weather_ilsa_od) Catch ex As Exception MsgBox("기상데이터2 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") Iserror = True End Try Try Dim TaC As New DSTableAdapters.weather_supdo_odTableAdapter TaC.Fill(DSET1.weather_supdo_od) Catch ex As Exception MsgBox("기상데이터3 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") Iserror = True End Try Try Dim TaC As New DSTableAdapters.weather_temp_odTableAdapter TaC.Fill(DSET1.weather_temp_od) Catch ex As Exception MsgBox("기상데이터4 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") Iserror = True End Try 'DSET1.tbl_weather.Merge(DSET1.tbl_weather_od) 'DSET1.weather_cha.Merge(DSET1.weather_cha_od) 'DSET1.weather_ilsa.Merge(DSET1.weather_ilsa_od) 'DSET1.weather_temp.Merge(DSET1.weather_temp_od) 'DSET1.weather_supdo.Merge(DSET1.weather_supdo_od) 'DSET1.tbl_weather_od.Clear() 'DSET1.weather_cha_od.Clear() 'DSET1.weather_ilsa_od.Clear() 'DSET1.weather_temp_od.Clear() 'DSET1.weather_supdo_od.Clear() DSET1.AcceptChanges() If Iserror = False Then DSET1.tbl_Desc.Rows(0)("versionw") = Version 'MsgBox(Version) DSET1.AcceptChanges() End If Work_msg("") End Sub Public Sub Read_ProfileData(Optional ByVal Version As String = "") '//2010.12.06 추가 Work_msg("표준프로파일 확인중") If Version = "" Then Dim L As New ArinLogin.ArinLOgin Dim VersionInfo As ArinLogin.ArinLOgin.sVersionInfo = Nothing VersionInfo = L.Get_LastVersion("P2") '//버젼을 가져오는데 eco 버젼만 가져오게 바꺼야겟죵 ^^ 구분자를 넣도록 합시닷! Version = VersionInfo.Ver End If Try Dim TaC As New DSTableAdapters.tbl_profile_odTableAdapter TaC.Fill(DSET1.tbl_profile_od) DSET1.tbl_Desc.Rows(0)("versionp") = Version DSET1.AcceptChanges() 'TaC.Fill(DSET2.tbl_profile) 'DSET2.tbl_Desc.Rows(0)("versionp") = Version DSET2.AcceptChanges() Catch ex As Exception MsgBox("표준프로파일 업데이트실패" & vbCrLf & ex.Message.ToString, MsgBoxStyle.Critical, "확인") End Try 'MsgBox(Version) Work_msg("") End Sub Public Function TOIT(ByVal obj As Object) As Integer If obj Is DBNull.Value Then Return 0 ElseIf obj.ToString = "" Then Return 0 Else If IsNumeric(obj) Then Return CInt(obj) Else ' MsgBox("[TOIT]숫자형식이 요구되지만 문자가 들어있습니다" & vbCrLf & obj.ToString, MsgBoxStyle.Critical, "확인") Throw New Exception("[TOIT]숫자형식이 요구되지만 문자가 들어있습니다" & vbCrLf & obj.ToString) ' Return 0 End If End If End Function Public Function TOSG(T As String, ByVal obj As Object) As Decimal If obj Is DBNull.Value Then Return 0 ElseIf obj.ToString = "" Then Return 0 Else If IsNumeric(obj) Then Try Return CDec(obj) Catch ex As Exception MsgBox("[TOSG:" + T + "]에서 '" & obj & "'") Throw New Exception("TOSG Error") Return 0 End Try Else 'MsgBox( & vbCrLf & obj.ToString, MsgBoxStyle.Critical, "확인") Throw New Exception("[TOSG" + T + "]숫자형식이 요구되지만 문자(" + obj.ToString() + ")가 들어있습니다") 'Return 0 End If End If End Function Public Function TOSG(ByVal obj As Object) As Decimal If obj Is DBNull.Value Then Return 0 ElseIf obj.ToString = "" Then Return 0 Else If IsNumeric(obj) Then Try Return CDec(obj) Catch ex As Exception 'MsgBox("[TOSG]에서 '" & obj & "'") Throw New Exception("[TOSG]에서 '" & obj & "'") Return 0 End Try Else 'MsgBox("[TOSG]숫자형식이 요구되지만 문자(" + obj.ToString() + ")가 들어있습니다" & vbCrLf & obj.ToString, MsgBoxStyle.Critical, "확인") Throw New Exception("[TOSG]숫자형식이 요구되지만 문자(" + obj.ToString() + ")가 들어있습니다" & vbCrLf & obj.ToString) End If End If End Function 'Public Function TOSG(T,ByVal obj As Object, Optional tag As Integer = 0) As Decimal ' If obj Is DBNull.Value Then ' Return 0 ' ElseIf obj.ToString = "" Then ' Return 0 ' Else ' If IsNumeric(obj) Then ' Try ' Return CDec(obj) ' Catch ex As Exception ' MsgBox("[TOSG:" + tag.ToString() + "]에서 '" & obj & "'") ' Return 0 ' End Try ' Else ' MsgBox("[TOSG" + tag.ToString() + "]숫자형식이 요구되지만 문자가 들어있습니다" & vbCrLf & obj.ToString, MsgBoxStyle.Critical, "확인") ' Return 0 ' End If ' End If 'End Function Public Function TOST(ByVal obj As Object) As String If obj Is DBNull.Value Then Return "" Else Return CStr(obj) End If End Function ''' ''' 데이터를 모두 되돌립니다. ''' ''' ''' ''' Public Sub Data_Cancel(ByRef SrcDs As DataTable, Optional ByVal DisplayLabel As ToolStripStatusLabel = Nothing) Dim Change As Integer Try Change = SrcDs.GetChanges.Rows.Count Catch ex As Exception Change = 0 End Try If Change > 0 Then If MsgBox("변경된 내용을 취소하시겠습니까?", CType(MsgBoxStyle.Critical + MsgBoxStyle.OkCancel, MsgBoxStyle), "확인") = MsgBoxResult.Ok Then SrcDs.RejectChanges() If Not DisplayLabel Is Nothing Then NOTICE("변경된 내용이 취소되었습니다", DisplayLabel, Color.Red) Else MsgBox("변경된 내용이 취소되었습니다", MsgBoxStyle.Information, "확인") End If Else If Not DisplayLabel Is Nothing Then NOTICE("취소되었습니다", DisplayLabel, Color.Blue) End If End If If Not DisplayLabel Is Nothing Then NOTICE("변경된 내용이 없습니다.", DisplayLabel, Color.Red) Else MsgBox("변경된 내용이 없습니다", MsgBoxStyle.Information, "확인") End If End Sub Public Function EndEdit(ByRef bs As BindingSource) As Boolean Try bs.EndEdit() Catch ex As System.Data.NoNullAllowedException MsgBox("반드시입력해야할 데이터가 없습니다" & vbCrLf & ex.Message, MsgBoxStyle.Critical, "입력오류") Return False Catch ex As Exception MsgBox(ex.Message.ToString, MsgBoxStyle.Critical, "처리되지않은 오류발생") Return False End Try Return True End Function Public Sub Check_Modify(ByRef DT As DataTable, Optional ByVal prompt As Boolean = True) Dim Cnt As Integer Try Cnt = DT.GetChanges.Rows.Count Catch ex As Exception Cnt = 0 End Try If Cnt < 1 Then NOTICE("변경된 내용이 없습니다", Nothing, Color.Red) Return End If If prompt Then If MsgBox("변경된 데이터를 저장하시겠습니까?", CType(MsgBoxStyle.Information + MsgBoxStyle.OkCancel, MsgBoxStyle), "저장확인") <> MsgBoxResult.Ok Then Return End If Try DT.AcceptChanges() '//Set All Green NOTICE("저장완료", Nothing, Color.Blue) My.Computer.Audio.PlaySystemSound(Media.SystemSounds.Exclamation) Catch ex As Exception MsgBox("데이터베이스 업데이트중 오류가 발생했습니다" & vbCrLf & vbCrLf & ex.ToString, MsgBoxStyle.Critical, "ERROR-") NOTICE("저장 실패!", Nothing, Color.Red) Finally 'view1.ActiveSheet.GetDataView(True) '//화면을 갱신한다. End Try End Sub '//지정된개체내의 컨트롤의 값을 초기화한다. Public Sub Clear_Control(ByVal Ctl As Control) Ctl.Focus() For Each C As Control In Ctl.Controls MsgBox(C.GetType.ToString) If C.Controls.Count > 1 Then Clear_Control(C) Else If C.GetType.ToString.ToUpper.IndexOf("TEXTBOX") <> -1 OrElse _ C.GetType.ToString.ToUpper.IndexOf("MYTB") <> -1 OrElse _ C.GetType.ToString.ToUpper.IndexOf("NTB") <> -1 Then If CType(C, TextBox).ReadOnly = False Then CType(C, TextBox).Text = "" ElseIf C.GetType.ToString.ToUpper.IndexOf("COMBOBOX") <> -1 OrElse _ C.GetType.ToString.ToUpper.IndexOf("MYCMB") <> -1 Then 'MsgBox("cb") CType(C, ComboBox).SelectedIndex = -1 End If End If Next End Sub Public Sub Work_msg(Optional ByVal P_m As String = "잠시만 기다려주세요", Optional ByVal pbar As Boolean = False) If P_m = "" Then Frm_Work.Dispose() Else If Frm_Work.Visible = False Then Frm_Work.Visible = True If Frm_Work.ProgressBar1.Visible <> pbar Then Frm_Work.ProgressBar1.Visible = pbar Frm_Work.Label1.Text = P_m My.Application.DoEvents() End If End Sub '''화면에메세지를 표시할때사용한다. Public Sub Work_msg_timer(Optional ByVal P_m As String = "잠시만 기다려주세요", Optional ByVal time As Short = 5) Frm_Warning.Left = CInt(MdiMain.Left + ((MdiMain.Width - Frm_Warning.Width) / 2)) Frm_Warning.Top = CInt(MdiMain.Top + ((MdiMain.Height - Frm_Warning.Height) / 2)) Frm_Warning.Term = time Frm_Warning.Second = time Frm_Warning.Label1.Text = P_m Frm_Warning.Timer1.Enabled = True Frm_Warning.Show() My.Application.DoEvents() End Sub Public Sub Work_plus() If Frm_Work.ProgressBar1.Visible = False Then Frm_Work.ProgressBar1.Visible = True Frm_Work.ProgressBar1.Value += 1 My.Application.DoEvents() End Sub Public Sub INitRow(ByVal Ctl As Control.ControlCollection) For Each C As Control In Ctl If C.Controls.Count > 1 Then INitRow(C.Controls) Else If C.GetType.ToString.ToUpper.IndexOf("MYTB") <> -1 Then If CType(C, MyTb).Text = "" Then CType(C, MyTb).Text = "0" ElseIf C.GetType.ToString.ToUpper.IndexOf("MYCMB") <> -1 Then If CType(C, MyCmb).Text = "" AndAlso CType(C, MyCmb).Items.Count > 0 Then CType(C, MyCmb).SelectedIndex = 0 End If End If Next End Sub Public Function DeCryptArea(ByRef data As Byte(), Optional ByVal pxorkey() As Byte = Nothing) As Byte() Dim out(data.Length - 1) As Byte Dim pos As Integer = 0 '//처음4바이트확인해서 보낸다. Dim XorKey() As Byte If pxorkey Is Nothing Then '//없으면 자동검출 XorKey = New Byte() {data(0), data(1), data(2), data(3)} Else '//있으면 그걸 사용한다. XorKey = New Byte() {pxorkey(0), pxorkey(1), pxorkey(2), pxorkey(3)} End If For i As Integer = 0 To data.Length - 1 out(i) = EnCryptByte(data(i), i, XorKey) Next Return out End Function Public Function DeCryptByte(ByVal num As Byte, ByVal column As Integer, Optional ByVal a() As Byte = Nothing) As Byte If a Is Nothing Then a = New Byte() {&HAC, &H29, &H55, &H42} Dim mok As Integer = column Mod 4 Return (num Xor a(mok)) End Function Public Function EnctryArea(ByRef data As Byte()) As Byte() Dim out(data.Length - 1) As Byte For i As Integer = 0 To data.Length - 1 Dim b As Byte = EnCryptByte(data(i), i) out(i) = b Next Return out End Function Public Function EnCryptByte(ByVal num As Byte, ByVal column As Integer, Optional ByVal a() As Byte = Nothing) As Byte If a Is Nothing Then a = New Byte() {&HAC, &H29, &H55, &H42} Dim mok As Integer = column Mod 4 Return (num Xor a(mok)) End Function End Module