Imports System.Data Imports System.Data.SqlTypes Imports System.Data.SqlClient Imports System.ComponentModel Imports UtilityLibrary.Win32 Imports System.Text Imports System.Threading Imports System.IO Public Class frmcoldview Inherits System.Windows.Forms.Form #Region " Vom Windows Form Designer generierter Code " Public Sub New() MyBase.New() ' Dieser Aufruf ist für den Windows Form-Designer erforderlich. InitializeComponent() ' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen End Sub ' Die Form überschreibt den Löschvorgang der Basisklasse, um Komponenten zu bereinigen. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub ' Für Windows Form-Designer erforderlich Private components As System.ComponentModel.IContainer 'HINWEIS: Die folgende Prozedur ist für den Windows Form-Designer erforderlich 'Sie kann mit dem Windows Form-Designer modifiziert werden. 'Verwenden Sie nicht den Code-Editor zur Bearbeitung. Friend WithEvents NoteCount As System.Windows.Forms.Label Friend WithEvents NoteLabel As System.Windows.Forms.Label Friend WithEvents ToolBar1 As System.Windows.Forms.ToolBar Friend WithEvents ToolBtnExit As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton1 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton2 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton3 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton4 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton5 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton6 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton7 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton8 As System.Windows.Forms.ToolBarButton Friend WithEvents PrintDocument1 As System.Drawing.Printing.PrintDocument Friend WithEvents ImageList1 As System.Windows.Forms.ImageList Friend WithEvents Panel1 As System.Windows.Forms.Panel ' Friend WithEvents OnDemand As AxARSOLELib.AxArsOle Friend WithEvents ToolBarButton9 As System.Windows.Forms.ToolBarButton Friend WithEvents ToolBarButton10 As System.Windows.Forms.ToolBarButton Friend WithEvents lblpages As System.Windows.Forms.Label Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container() Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(frmcoldview)) Me.NoteCount = New System.Windows.Forms.Label() Me.NoteLabel = New System.Windows.Forms.Label() Me.ToolBar1 = New System.Windows.Forms.ToolBar() Me.ToolBtnExit = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton1 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton2 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton3 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton4 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton5 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton6 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton7 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton8 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton9 = New System.Windows.Forms.ToolBarButton() Me.ToolBarButton10 = New System.Windows.Forms.ToolBarButton() Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components) Me.PrintDocument1 = New System.Drawing.Printing.PrintDocument() Me.Panel1 = New System.Windows.Forms.Panel() Me.lblpages = New System.Windows.Forms.Label() Me.SuspendLayout() ' 'NoteCount ' Me.NoteCount.Location = New System.Drawing.Point(0, 0) Me.NoteCount.Name = "NoteCount" Me.NoteCount.Size = New System.Drawing.Size(100, 23) Me.NoteCount.TabIndex = 10 ' 'NoteLabel ' Me.NoteLabel.Location = New System.Drawing.Point(0, 0) Me.NoteLabel.Name = "NoteLabel" Me.NoteLabel.Size = New System.Drawing.Size(100, 23) Me.NoteLabel.TabIndex = 11 ' 'ToolBar1 ' Me.ToolBar1.DropDownArrows = True Me.ToolBar1.Location = New System.Drawing.Point(0, 0) Me.ToolBar1.Name = "ToolBar1" Me.ToolBar1.ShowToolTips = True Me.ToolBar1.Size = New System.Drawing.Size(120, 42) Me.ToolBar1.TabIndex = 12 ' 'ToolBtnExit ' Me.ToolBtnExit.Name = "ToolBtnExit" ' 'ToolBarButton1 ' Me.ToolBarButton1.Name = "ToolBarButton1" ' 'ToolBarButton2 ' Me.ToolBarButton2.Name = "ToolBarButton2" ' 'ToolBarButton3 ' Me.ToolBarButton3.Name = "ToolBarButton3" ' 'ToolBarButton4 ' Me.ToolBarButton4.ImageIndex = 5 Me.ToolBarButton4.Name = "ToolBarButton4" Me.ToolBarButton4.ToolTipText = "Ansicht verkleinern" ' 'ToolBarButton5 ' Me.ToolBarButton5.ImageIndex = 4 Me.ToolBarButton5.Name = "ToolBarButton5" Me.ToolBarButton5.ToolTipText = "Ansicht vergrössern" ' 'ToolBarButton6 ' Me.ToolBarButton6.ImageIndex = 6 Me.ToolBarButton6.Name = "ToolBarButton6" Me.ToolBarButton6.Style = System.Windows.Forms.ToolBarButtonStyle.Separator ' 'ToolBarButton7 ' Me.ToolBarButton7.ImageIndex = 6 Me.ToolBarButton7.Name = "ToolBarButton7" Me.ToolBarButton7.ToolTipText = "Notizen bearbeiten" ' 'ToolBarButton8 ' Me.ToolBarButton8.ImageIndex = 6 Me.ToolBarButton8.Name = "ToolBarButton8" Me.ToolBarButton8.Visible = False ' 'ToolBarButton9 ' Me.ToolBarButton9.ImageIndex = 9 Me.ToolBarButton9.Name = "ToolBarButton9" Me.ToolBarButton9.ToolTipText = "Dokument nach links drehen" ' 'ToolBarButton10 ' Me.ToolBarButton10.ImageIndex = 10 Me.ToolBarButton10.Name = "ToolBarButton10" Me.ToolBarButton10.ToolTipText = "Dokument nach rechts drehen" ' 'ImageList1 ' Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer) Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent Me.ImageList1.Images.SetKeyName(0, "") Me.ImageList1.Images.SetKeyName(1, "") Me.ImageList1.Images.SetKeyName(2, "") Me.ImageList1.Images.SetKeyName(3, "") Me.ImageList1.Images.SetKeyName(4, "") Me.ImageList1.Images.SetKeyName(5, "") Me.ImageList1.Images.SetKeyName(6, "") Me.ImageList1.Images.SetKeyName(7, "") Me.ImageList1.Images.SetKeyName(8, "") Me.ImageList1.Images.SetKeyName(9, "") Me.ImageList1.Images.SetKeyName(10, "") ' 'Panel1 ' Me.Panel1.Dock = System.Windows.Forms.DockStyle.Fill Me.Panel1.Location = New System.Drawing.Point(0, 42) Me.Panel1.Name = "Panel1" Me.Panel1.Size = New System.Drawing.Size(120, 0) Me.Panel1.TabIndex = 8 ' 'lblpages ' Me.lblpages.Location = New System.Drawing.Point(671, 8) Me.lblpages.Name = "lblpages" Me.lblpages.RightToLeft = System.Windows.Forms.RightToLeft.Yes Me.lblpages.Size = New System.Drawing.Size(88, 16) Me.lblpages.TabIndex = 9 Me.lblpages.Text = "1/1" ' 'frmcoldview ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(120, 0) Me.Controls.Add(Me.lblpages) Me.Controls.Add(Me.Panel1) Me.Controls.Add(Me.NoteCount) Me.Controls.Add(Me.NoteLabel) Me.Controls.Add(Me.ToolBar1) Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) Me.Name = "frmcoldview" Me.Text = "COLD-Dokumentanzeige" Me.ResumeLayout(False) Me.PerformLayout() End Sub #End Region #Region "Deklarationen" Dim Show_Direkt As Boolean = False Dim m_print As Boolean = False Property PrintIt() As Boolean Get Return m_print End Get Set(ByVal Value As Boolean) m_print = Value End Set End Property Dim m_uvmzvdokumenttyp As String Property UVMZVDokumenttyp() As String Get Return m_uvmzvdokumenttyp End Get Set(ByVal Value As String) m_uvmzvdokumenttyp = Value End Set End Property Dim m_belegart As String Property belegart() As String Get Return m_belegart End Get Set(ByVal Value As String) m_belegart = Value End Set End Property Dim m_auftragnr As String Property Auftragnr() As String Get Return m_auftragnr End Get Set(ByVal Value As String) m_auftragnr = Value End Set End Property Dim m_erstellungsdatum As String Property Erstellungsdatum() As String Get Return m_erstellungsdatum End Get Set(ByVal Value As String) m_erstellungsdatum = Value End Set End Property Dim m_scolddokumentid As String Property Colddokumentid() As String Get Return m_scolddokumentid End Get Set(ByVal Value As String) m_scolddokumentid = Value End Set End Property Dim m_dokumentid As String Property DokumentId() As String Get Return m_dokumentid End Get Set(ByVal Value As String) m_dokumentid = Value End Set End Property Dim m_partnernr As String Property PartnerNr() As String Get Return m_partnernr End Get Set(ByVal Value As String) m_partnernr = Value 'Nova 'While Len(m_partnernr) < 9 ' m_partnernr = "0" & m_partnernr 'End While 'Nova Ende End Set End Property Dim m_dokumenttyp As Integer Property Dokumenttyp() As Integer Get Return m_dokumenttyp End Get Set(ByVal Value As Integer) m_dokumenttyp = Value End Set End Property Dim m_colddokumentid As String Dim m_coldfolder As String Dim server Dim user Dim pw Dim xnumdocs Dim xnumfields Dim xname As String Dim i Dim v1 Dim v2 Dim numservers Dim rc As Short Dim ret As Short Dim tmp Dim posvscroll As Integer = 0 Dim poshscroll As Integer = 0 Dim WithEvents hscrol As New Windows.Forms.HScrollBar() Dim WithEvents vscrol As New Windows.Forms.VScrollBar() Dim m_currentpage As Integer Dim irotate As Integer = 0 Property CurrentPage() As Integer Get Return m_currentpage End Get Set(ByVal Value As Integer) m_currentpage = Value End Set End Property #End Region Const STRING_BUFFER_LENGTH As Integer = 255 Dim WindowArray As New ArrayList() Public zf As Short = 100 Public o As Object Public k As Object Dim txtuser As String = "" Dim txtdatetime As String = "" Dim txttext As String = "" Dim page As Object Dim publ As Object Dim copied As Object Dim numnote As Object Dim notes As New DataTable() Dim m_docnotfound As Boolean Dim numpages As Integer = 1 Dim curpage As Integer = 1 Public Connectionstring As String Property DocNotFound() As Boolean Get Return m_docnotfound End Get Set(ByVal Value As Boolean) m_docnotfound = Value End Set End Property #Region "Datenzugriffe" Private Function Get_Cold_Data_by_Dokumentid() Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim conn As New SqlConnection(Connectionstring) scmCmdToExecute.CommandText = "dbo.sp_get_coldfolder_by_documentid" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumentid", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.DokumentId)) sdaAdapter.Fill(dtToReturn) If Me.Colddokumentid = "" Then Me.m_colddokumentid = dtToReturn.Rows(0).Item(1) Else Me.m_colddokumentid = Me.Colddokumentid End If 'HOST-Folder' If dtToReturn.Rows.Count = 0 Then Me.m_coldfolder = "TGKB Kundenoutput AGI-OMS für EDOKA User" Else Me.m_coldfolder = dtToReturn.Rows(0).Item(0) End If Catch ex As Exception Throw New Exception("Get_Cold_Folder :" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function Private Function Get_Cold_Data_by_Dokumenttyp() Dim scmCmdToExecute As SqlCommand = New SqlCommand() Dim conn As New SqlConnection(Connectionstring) scmCmdToExecute.CommandText = "dbo.sp_get_coldfolder_by_documenttyp" scmCmdToExecute.CommandType = CommandType.StoredProcedure Dim dtToReturn As DataTable = New DataTable() Dim sdaAdapter As SqlDataAdapter = New SqlDataAdapter(scmCmdToExecute) Try scmCmdToExecute.Connection = conn scmCmdToExecute.Parameters.Add(New SqlParameter("@dokumenttyp", SqlDbType.VarChar, 255, ParameterDirection.Input, True, 10, 0, "", DataRowVersion.Proposed, Me.Dokumenttyp)) sdaAdapter.Fill(dtToReturn) Me.m_coldfolder = dtToReturn.Rows(0).Item(0) Catch ex As Exception Throw New Exception("Get_Cold_Folder :" & scmCmdToExecute.CommandText & "::Error occured." & ex.Message, ex) Finally scmCmdToExecute.Dispose() sdaAdapter.Dispose() End Try End Function #End Region #Region "COLD_Ondemand_Funktionen" Public Function Show_Dokument(ByVal folder As String, ByVal dokumentid As String) As Boolean Show_Dokument = True Dim rc Dim ret Dim xnumdocs Dim i As Short Dim tmp As String Try tmp = coldstarter + " /e " + Globals.Applikationsdaten.Rows(0).Item("coldgui") + " /S " + Globals.Applikationsdaten.Rows(0).Item("coldsystem") + " /U " + Globals.Applikationsdaten.Rows(0).Item("colduser") + " /P " + Globals.Applikationsdaten.Rows(0).Item("coldpassword") + " /f " + m_coldfolder + " /d " + m_colddokumentid + " /t " + Me.Erstellungsdatum rc = Shell(coldstarter + " /e " + Globals.Applikationsdaten.Rows(0).Item("coldgui") + " /S " + Globals.Applikationsdaten.Rows(0).Item("coldsystem") + " /U " + Globals.Applikationsdaten.Rows(0).Item("colduser") + " /P " + Globals.Applikationsdaten.Rows(0).Item("coldpassword") + " /f " + m_coldfolder + " /d " + m_colddokumentid + " /t " + Me.Erstellungsdatum, AppWinStyle.Hide, False) Exit Function Catch ex As Exception End Try End Function #End Region Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim cid As String Dim yy As String Dim mm As String Dim dd As String Dim comparedate As DateTime Get_Cold_Data_by_Dokumentid() '20121021 - Immer Show_Direkt Me.Show_Direkt = True Try If UCase(Microsoft.VisualBasic.Left(Me.m_colddokumentid, 3)) = "SCA" Then cid = Microsoft.VisualBasic.Right(Me.m_colddokumentid, 17) cid = Microsoft.VisualBasic.Left(cid, 14) Else cid = Microsoft.VisualBasic.Right(Me.m_colddokumentid, 14) End If yy = Microsoft.VisualBasic.Left(cid, 4) mm = Microsoft.VisualBasic.Mid(cid, 5, 2) dd = Microsoft.VisualBasic.Mid(cid, 7, 2) comparedate = yy + "." + mm + "." + dd If comparedate.Date <= DateAdd(DateInterval.Day, -1, Now) Then Me.Show_Direkt = True Else '20121018_Korrekturmassnahme OnDemand 8.5 Me.Show_Direkt = True 'Me.Show_Direkt = False End If Catch cid = Me.Colddokumentid End Try If Not Show_Dokument(Me.m_coldfolder, Me.m_colddokumentid) Then Me.DocNotFound = True End If Exit Sub End Sub Public Function get_annotations() Dim rc As DataRowCollection Dim newrow As DataRow() rc = notes.Rows Dim rowvals(7) As Object Dim i As Integer Me.numnote = Nothing 'ret = Me.OnDemand.GetNumDocAnnotations(Me.numnote) For i = 0 To Me.numnote - 1 page = Nothing publ = Nothing copied = Nothing 'ret = Me.OnDemand.GetAnnotationForDoc(i, txttext, txtuser, txtdatetime, page, publ, copied) rowvals(0) = i rowvals(1) = txttext rowvals(3) = txtuser rowvals(2) = txtdatetime rowvals(4) = page rowvals(5) = publ rowvals(6) = copied rowvals(7) = "" notes.Rows.Add(rowvals) Next If Me.numnote > 0 Then Me.NoteCount.Text = Me.numnote.ToString Me.NoteCount.Visible = True Me.NoteLabel.Visible = True Else Me.NoteCount.Visible = False Me.NoteLabel.Visible = False End If End Function Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick Select Case ToolBar1.Buttons.IndexOf(e.Button) Case 0 Me.Close() Case 1 'Me.OnDemand.PrintDoc(-1, 0, Me.PrintDocument1.PrinterSettings.PrinterName, True, 1, 3, 0.5, 0.5, 0.5, 0.5, False) 'Me.CurrentPage = Me.CurrentPage - 1 'ret = Me.OnDemand.SetDocCurrentPage(Me.CurrentPage) If ret <> 0 Then Me.CurrentPage = Me.CurrentPage + 1 Case 2 'Me.CurrentPage = Me.CurrentPage - 1 'ret = Me.OnDemand.SetDocCurrentPage(Me.CurrentPage) 'If ret <> 0 Then Me.CurrentPage = Me.CurrentPage + 1 'Dim o As Object 'o = Nothing 'ret = OnDemand.GetDocCurrentPage(o) 'If ret = 0 Then Me.curpage = o 'Me.lblpages.Text = Str(curpage) + "/" + Str(numpages) Case 3 'Me.CurrentPage = Me.CurrentPage + 1 'ret = Me.OnDemand.SetDocCurrentPage(Me.CurrentPage) 'If ret <> 0 Then Me.CurrentPage = Me.CurrentPage - 1 'Dim o As Object 'o = Nothing 'ret = OnDemand.GetDocCurrentPage(o) 'If ret = 0 Then Me.curpage = o 'Me.lblpages.Text = Str(curpage) + "/" + Str(numpages) Case 4 'zf = zf - 25 'o = Nothing 'k = Nothing 'If zf < 25 Then zf = 25 'ret = Me.OnDemand.SetDocZoom(zf, o, k) Case 5 'zf = zf + 25 'o = Nothing 'k = Nothing 'If zf > 1000 Then zf = 1000 'ret = Me.OnDemand.SetDocZoom(zf, o, k) Case 7 'Dim f As New frmNotes() 'f.notes = Me.notes 'f.ondemand = Me.OnDemand 'f.ShowDialog() 'If f.DialogResult = DialogResult.OK Then ' Me.notes.Rows.Clear() ' Me.get_annotations() 'End If Case 10 'If Me.irotate = 0 Then Me.irotate = 360 'Me.irotate = Me.irotate - 90 'Me.OnDemand.SetDocRotation(irotate) Case 9 'If Me.irotate = 270 Then Me.irotate = -90 'Me.irotate = Me.irotate + 90 'Me.OnDemand.SetDocRotation(Me.irotate) End Select End Sub Public Sub PRINTdOC() 'Me.OnDemand.PrintDoc(-1, 0, Me.PrintDocument1.PrinterSettings.PrinterName, True, 1, 3, 4, 4, 0, 6, True) 'Me.CurrentPage = Me.CurrentPage - 1 'ret = Me.OnDemand.SetDocCurrentPage(Me.CurrentPage) 'If ret <> 0 Then Me.CurrentPage = Me.CurrentPage + 1 End Sub 'Public Function GetColdDokumente() As DataTable ' Dim m_dokument As New edokadb.clsDokument() ' Get_Cold_Data_by_Dokumenttyp() ' If Not Me.Cold_Login Then Exit Function ' Get_Folder_Documents(Me.m_coldfolder) 'End Function Private Function Get_Folder_Documents(ByVal Folder As String) As Boolean 'ret = Me.OnDemand.SetUserMessageMode(0) 'ret = Me.OnDemand.OpenFolder(Folder) 'If ret <> 0 Then ' MsgBox("Der gewählte Order " & Folder & " kann nicht geöffnet werden", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Exit Function 'End If 'ret = Me.OnDemand.ClearFolderSearchFields() 'If ret <> 0 Then ' MsgBox("Die Suchliste konnte nicht initialisiert werden", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Exit Function 'End If 'Dim xx As String 'xx = "" 'ret = Me.OnDemand.SetFolderSearchFieldData("Partner-Nr.", 1, Me.PartnerNr, xx) ''ret = Me.OnDemand.SetFolderSearchFieldData("Dok.-Status", 11, "Aktuell", xx) 'If ret <> 0 Then ' MsgBox("Fehler beim setzen des Suchkriteriums", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Exit Function 'End If 'ret = Me.OnDemand.SearchFolder(False) 'If ret <> 0 Then ' MsgBox("Beim Zugriff auf das COLD ist ein Fehler aufgetreten", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Exit Function 'End If 'ret = Me.OnDemand.GetNumDocsInList(xnumdocs) 'If xnumdocs < 1 Then ' MyMsg.show_standardmessage(81, MsgBoxStyle.Information) ' Me.OnDemand.Logoff() ' Exit Function 'End If 'Dim tmp As String 'Dim i As Short 'Dim i1 As Short 'tmp = "" 'ret = OnDemand.GetNumFolderDisplayFields(xnumfields) 'Dim foldernames(xnumfields) As String 'For i = 0 To xnumfields - 1 ' tmp = Nothing ' OnDemand.GetFolderDisplayFieldName(i, tmp) ' foldernames(i) = tmp ' MsgBox(foldernames(i)) 'Next 'Dim t As New DataTable() 'Dim newrow As DataRow 'Dim rc As DataRowCollection 'rc = t.Rows 'Dim rowvals(xnumfields) As Object 'For i = 0 To xnumdocs ' For i1 = 0 To xnumfields ' ret = OnDemand.GetDocDisplayValue(i, i1, tmp) ' If ret = 0 Then ' rowvals(i1) = tmp ' End If ' Next i1 ' newrow = rc.Add(rowvals) 'Next i End Function Private Sub vscrol_ValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles vscrol.ValueChanged 'Try ' If Me.vscrol.Value < Me.posvscroll Then zf = 0 Else zf = 1 ' o = 60 ' o = Nothing ' Me.posvscroll = Me.vscrol.Value ' ret = Me.OnDemand.ScrollDocVert(zf, o) 'Catch ex As Exception ' ' MsgBox(ret) ' ' MsgBox(ex.Message) 'End Try End Sub Private Sub hscrol_ValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles hscrol.ValueChanged 'Try ' If Me.hscrol.Value < Me.poshscroll Then zf = 0 Else zf = 1 ' o = 60 ' o = Nothing ' Me.poshscroll = Me.hscrol.Value ' ret = Me.OnDemand.ScrollDocHorz(zf, o) 'Catch ex As Exception ' ' MsgBox(ret) ' ' MsgBox(ex.Message) 'End Try End Sub Private Sub frmcoldview_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Resize Me.lblpages.Left = Me.ToolBar1.Width - Me.lblpages.Width End Sub #Region "Windows Tasks" Private Sub killtask(ByVal application As String) Dim myProcess() As Process Try myProcess = Process.GetProcessesByName(application) While myProcess.Length > 0 myProcess(0).Kill() Thread.Sleep(200) myProcess = Process.GetProcessesByName(application) End While Catch Finally End Try End Sub #End Region #Region "Freitextsuche" Dim suchfeldstring1 As String = "" Dim suchfeldstring2 As String = "" Private Function setsuchfeldstring(ByVal feld As String, ByVal wert As String) As Boolean 'ret = Me.OnDemand.SetFolderSearchFieldData(feld, 1, wert, suchfeldstring2) 'If ret <> 0 Then Return False Else Return True End Function Private Function Cold_Functions(ByVal fnkt As Integer, ByVal folder As String) As Boolean 'Select Case fnkt ' Case 1 'Folder öffnen ' ret = Me.OnDemand.OpenFolder(folder) ' If ret <> 0 Then ' MsgBox("Der gewählte Order " & folder & " kann nicht geöffnet werden", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Return False ' Else ' Return True ' End If ' Case 2 'Suchfelder initialisieren ' ret = Me.OnDemand.ClearFolderSearchFields() ' If ret <> 0 Then ' MsgBox("Die Suchliste konnte nicht initialisiert werden", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Return False ' Else ' Return True ' End If ' Case 3 'Suche ' ret = Me.OnDemand.SearchFolder(False) ' If ret <> 0 Then ' MsgBox("Beim Zugriff auf das COLD ist ein Fehler aufgetreten", MsgBoxStyle.Critical) ' Me.OnDemand.Logoff() ' Return False ' Else ' Return True ' End If ' Case 4 ' 'Dim xnumdocs ' ret = Me.OnDemand.GetNumDocsInList(xnumdocs) ' If xnumdocs < 1 Then ' Return False ' Else ' Return True ' End If ' Case Else 'End Select End Function Private Function Return_Searchdata(ByVal rettable As DataTable) 'Dim s As String 'Dim newrow As DataRow 'Dim i1 As Integer 'Dim rc As DataRowCollection 'rc = rettable.Rows 'Dim tmp As String 'Dim rowvals(rettable.Columns.Count) As Object 'ret = OnDemand.GetNumFolderDisplayFields(xnumfields) 'For i = 0 To xnumdocs - 1 ' For i1 = 0 To xnumfields ' tmp = "" ' ret = OnDemand.GetDocDisplayValue(i, i1, tmp) ' If ret = 0 Then ' rowvals(i1) = tmp ' Else ' ' rowvals(i1) = "" ' End If ' Next i1 ' newrow = rc.Add(rowvals) 'Next i End Function Public Function frmSuchform_Freitextsuche(ByVal suchdaten As DataTable, ByVal suchstring As String, ByVal datenbestand As String) As DataTable 'If Not Cold_Login() Then Exit Function 'Select Case datenbestand ' Case "UVM" ' If Not Cold_Functions(1, "TGKB UVM-Verträge") Then Exit Function ' If Not Cold_Functions(2, "") Then Exit Function ' Dim i As Integer ' For i = 0 To suchdaten.Rows.Count - 1 ' If Not setsuchfeldstring2(suchdaten.Rows(i).Item("feld"), suchdaten.Rows(i).Item("wert1"), suchdaten.Rows(i).Item("wert2"), suchdaten.Rows(i).Item("OP")) Then Exit Function ' Next ' If Not Cold_Functions(3, "") Then Exit Function ' Dim Resultdata As New DataTable() ' If Not Cold_Functions(4, "") Then ' Return Resultdata ' Else ' resultdata.Columns.Add("Bezeichnung") '0 ' resultdata.Columns.Add("NRDOC00") '1 ' resultdata.Columns.Add("PartnerNr") '2 ' resultdata.Columns.Add("BKPAR00") '3 ' resultdata.Columns.Add("NRAUF00") '4 ' resultdata.Columns.Add("Erstellungsdatum") '5 ' resultdata.Columns.Add("DMARC00") '6 ' resultdata.Columns.Add("hostdokumenttyp") '7 ' Dim tmp As String ' Dim newrow As DataRow ' Dim i1 As Integer ' Dim rc As DataRowCollection ' rc = Resultdata.Rows ' Dim rowvals(Resultdata.Columns.Count - 1) As Object ' ret = OnDemand.GetNumFolderDisplayFields(xnumfields) ' For i = 0 To xnumdocs - 1 ' For i1 = 0 To xnumfields - 1 ' tmp = "" ' ret = OnDemand.GetDocDisplayValue(i, i1, tmp) ' If ret = 0 Then ' Select Case i1 ' Case 0 ' rowvals(7) = Microsoft.VisualBasic.Left(tmp, 6) ' rowvals(0) = tmp ' Case 1 ' rowvals(2) = tmp ' rowvals(3) = "" ' Case 2 ' rowvals(5) = tmp ' Case 3 ' rowvals(4) = tmp ' Case 4 ' rowvals(1) = tmp ' Case 5 ' rowvals(6) = tmp ' End Select ' End If ' Next i1 ' newrow = rc.Add(rowvals) ' Next i ' Return Resultdata ' End If ' Case "ZV" ' If Not Cold_Functions(1, "TGKB ZV-Scanning Belege (erweiterte Suche)") Then Exit Function ' If Not Cold_Functions(2, "") Then Exit Function ' Dim i As Integer ' For i = 0 To suchdaten.Rows.Count - 1 ' If Not setsuchfeldstring2(suchdaten.Rows(i).Item("feld"), suchdaten.Rows(i).Item("wert1"), suchdaten.Rows(i).Item("wert2"), suchdaten.Rows(i).Item("op")) Then Exit Function ' Next ' If Not Cold_Functions(3, "") Then Exit Function ' Dim Resultdata As New DataTable() ' If Not Cold_Functions(4, "") Then ' Return Resultdata ' Else ' Resultdata.Columns.Add("Bezeichnung") '0 ' Resultdata.Columns.Add("NRDOC00") '1 ' Resultdata.Columns.Add("NRAUF00") '2 ' Resultdata.Columns.Add("PartnerNr") '3 ' Resultdata.Columns.Add("BKPAR00") '4 ' Resultdata.Columns.Add("NRPOS00") '5 ' Resultdata.Columns.Add("NEVVG00") '6 ' Resultdata.Columns.Add("CDWAEAI") '7 ' Resultdata.Columns.Add("BTBET00") '8 ' Resultdata.Columns.Add("DMVAL00") '9 ' Resultdata.Columns.Add("CDZAH00") '10 ' Resultdata.Columns.Add("NRREF00") '11 ' Resultdata.Columns.Add("NEVVG01") '12 ' Resultdata.Columns.Add("NRPCK00") '13 ' Resultdata.Columns.Add("NRBCL00") '14 ' Resultdata.Columns.Add("CDVAR00") '15 ' Resultdata.Columns.Add("BEEAD00") '16 ' Resultdata.Columns.Add("BESAD00") '17 ' Resultdata.Columns.Add("DMARC00") '18 ' Resultdata.Columns.Add("hostdokumenttyp") '19 ' 'COLD-Daten abfüllen ' Dim tmp As String ' Dim newrow As DataRow ' Dim i1 As Integer ' Dim rc As DataRowCollection ' rc = Resultdata.Rows ' Dim rowvals(Resultdata.Columns.Count - 1) As Object ' ret = OnDemand.GetNumFolderDisplayFields(xnumfields) ' For i = 0 To xnumdocs - 1 ' For i1 = 0 To xnumfields - 1 ' tmp = "" ' ret = OnDemand.GetDocDisplayValue(i, i1, tmp) ' If ret = 0 Then ' Select Case i1 ' Case 0 ' rowvals(0) = tmp ' rowvals(19) = Microsoft.VisualBasic.Left(tmp, 6) ' Case 1 ' rowvals(2) = tmp ' Case 2 ' rowvals(5) = tmp ' Case 3 ' rowvals(6) = tmp ' Case 4 ' rowvals(7) = tmp ' Case 5 ' rowvals(8) = tmp ' Case 6 ' rowvals(9) = tmp ' Case 7 ' rowvals(1) = tmp ' Case 8 ' rowvals(3) = tmp ' rowvals(4) = "" ' Case 9 ' rowvals(10) = tmp ' Case 10 ' rowvals(11) = tmp ' Case 11 ' rowvals(12) = tmp ' Case 12 ' rowvals(13) = tmp ' Case 13 ' rowvals(14) = tmp ' Case 14 ' rowvals(15) = tmp ' Case 15 ' rowvals(16) = tmp ' Case 16 ' rowvals(17) = tmp ' Case 17 ' rowvals(18) = tmp ' End Select ' End If ' Next i1 ' newrow = rc.Add(rowvals) ' Next i ' Return Resultdata ' End If ' Case Else ' Return suchdaten 'End Select End Function ' #define ARS_OLE_OPR_EQUAL 1 '#define ARS_OLE_OPR_NOT_EQUAL 2 '#define ARS_OLE_OPR_LESS_THAN 3 '#define ARS_OLE_OPR_LESS_THAN_OR_EQUAL 4 '#define ARS_OLE_OPR_GREATER_THAN 5 '#define ARS_OLE_OPR_GREATER_THAN_OR_EQUAL 6 '#define ARS_OLE_OPR_BETWEEN 7 '#define ARS_OLE_OPR_NOT_BETWEEN 8 '#define ARS_OLE_OPR_IN 9 '#define ARS_OLE_OPR_NOT_IN 10 '#define ARS_OLE_OPR_LIKE 11 '#define ARS_OLE_OPR_NOT_LIKE 12 Private Function setsuchfeldstring2(ByVal feld As String, ByVal wert As String, ByVal wert2 As String, ByVal [Operator] As String) As Boolean Dim op As Integer Select Case [Operator] Case "zwischen" op = 7 Case "=" op = 1 Case "<>" op = 2 Case "<" op = 3 Case "<=" op = 4 Case ">" op = 5 Case ">=" op = 6 Case "wie" op = "11" Case "nicht wie" op = 12 Case "nicht zwischen" op = 8 Case "nicht in" op = 10 Case "in" op = 9 Case Else op = 1 End Select 'ret = Me.OnDemand.SetFolderSearchFieldData(feld, op, wert, wert2) If ret <> 0 Then Return False Else Return True End Function #End Region End Class