Files
ECO2-OD/ArinWarev1/Module/Pub.vb
2023-05-20 22:27:10 +09:00

615 lines
24 KiB
VB.net

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
''' <summary>
''' 인터넷에 연결되었는지를 체크합니다.
''' </summary>
''' <returns></returns>
''' <remarks></remarks>
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
''' <summary>
''' 데이터를 모두 되돌립니다.
''' </summary>
''' <param name="SrcDs"></param>
''' <param name="DisplayLabel"></param>
''' <remarks></remarks>
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