Dim ListBox1$() AS string Dim ListBox2$() AS string Begin Dialog NewDialog 110,13,177,164,"İki Veriyi Kıyaslama Aracı", .DisplayIt OKButton 88,120,40,15, "Tamam", .OKButton1 PushButton 7,11,56,13, "Veritabanı Seçiniz", .PushButton1 DropListBox 85,33,60,14, ListBox1$(), .DropListBox1 Text 21,32,56,14, "1. Kıyaslanacak Veri", .Text1 Text 21,49,56,14, "2. Kıyaslanacak Veri", .Text2 DropListBox 85,49,60,10, ListBox2$(), .DropListBox2 Text 21,102,58,12, "Yeni Veritabanı Adı", .Text5 TextBox 85,102,60,12, .txtVeritabani CancelButton 38,120,40,15, "İptal", .CancelButton1 OptionGroup .groupExtractType OptionButton 27,78,40,15, "Aynı", .OptionButton1 OptionButton 89,78,40,15, "Farklı", .OptionButton2 GroupBox 5,66,158,34, "Operasyon", .Groupbox1 Text 71,10,89,15, "Text", .veritabani End Dialog Option Explicit Dim filename As String Dim acilirListeVerisi1 As String Dim acilirListeVerisi2 As String Dim extractionType As Boolean Dim veritabaniAdi As String Dim working_directory As String Dim exitDialog As Boolean Dim exitScript As Boolean Sub Main working_directory = Client.WorkingDirectory Call menu() If Not exitScript Then Call DirectExtraction() 'perform the extraction End If client.refreshFileExplorer End Sub Function menu() Dim dlg As NewDialog Dim button As Integer Dim filebar As Object Dim source As Object Dim table As Object Dim fields As Integer Dim i,j,k As Integer Dim field As Object exitDialog = FALSE Do button = Dialog(dlg) Select Case button Case -1 If dlg.DropListBox1 > -1 Then acilirListeVerisi1 = ListBox1$(dlg.DropListBox1) Else acilirListeVerisi1 = "" End If If dlg.DropListBox2 > -1 Then acilirListeVerisi2 = ListBox2$(dlg.DropListBox2) Else acilirListeVerisi2 = "" End If extractionType = dlg.groupExtractType veritabaniAdi = dlg.txtVeritabani If validateMenu() Then exitDialog = TRUE End If Case 0 exitDialog = TRUE exitScript = TRUE Case 1' select database Set filebar=CreateObject("ideaex.fileexplorer") filebar.displaydialog filename=filebar.selectedfile If filename="" Then exitDialog = TRUE exitScript = TRUE Else 'MsgBox filename Set source = client.opendatabase(filename) Set table = source.tabledef fields = table.count ReDim listBox1$(fields) ReDim listBox2$(fields) j = 0 k = 0 For i = 1 To fields Set field = table.getfieldat(i) listBox1$(j) = field.name j = j + 1 listBox2$(k) = field.name k = k + 1 Next i End If End Select Loop While exitDialog = FALSE Set filebar=Nothing Set field=Nothing Set table = Nothing Set source = Nothing End Function Function validateMenu() As Boolean validateMenu = TRUE If filename = "" Then MsgBox "Lütfen bir veritabanı seçiniz", MB_ICONEXCLAMATION, "Hata" validateMenu = FALSE ElseIf acilirListeVerisi1 = "" Then MsgBox "Lütfen birinci kıyaslanacak veriyi seçiniz", MB_ICONEXCLAMATION, "Hata" validateMenu = FALSE ElseIf acilirListeVerisi2 = "" Then MsgBox "Lütfen ikinci kıyaslanacak veriyi seçiniz", MB_ICONEXCLAMATION, "Hata" validateMenu = FALSE End If If veritabaniAdi = "" Then MsgBox "Lütfen yeni veritabanı adını giriniz", MB_ICONEXCLAMATION, "Hata" validateMenu = FALSE End If If checkForSpecialChar(veritabaniAdi, "\/:*?""<>[]|") Then MsgBox " \/:*?""<>[]| karakterleri dosya adlandımada kullanılamazlar", MB_ICONEXCLAMATION, "Hata" validateMenu = false End If End Function Function checkForSpecialChar(temp_string As String, temp_list As String) As Boolean Dim strLen As Integer Dim tempChar As String Dim i As Integer Dim pos As Integer checkForSpecialChar = FALSE strlen = Len(temp_list) For i = 1 To strLen tempChar = Mid(temp_list, i, 1) pos = InStr(1, temp_string, tempChar) If pos > 0 Then checkForSpecialChar = TRUE End If Next i End Function ' Data: Direct Extraction Function DirectExtraction Dim db As database Dim task As task Dim dbName As String Dim eqn As String Set db = Client.OpenDatabase(filename) Set task = db.Extraction task.IncludeAllFields dbName = client.UniqueFilename(veritabaniAdi) If extractionType Then eqn = "@Strip(" & acilirListeVerisi1 & ") <> @Strip(" & acilirListeVerisi2 & ")" Else eqn = "@Strip(" & acilirListeVerisi1 & ") == @Strip(" & acilirListeVerisi2 & ")" End If task.AddExtraction dbName, "", eqn task.CreateVirtualDatabase = False task.PerformTask 1, db.Count Set task = Nothing Set db = Nothing Client.OpenDatabase (dbName) End Function Function DisplayIt(ControlID$, Action%, SuppValue%) If filename = "" Then DlgText "veritabani", "Dosya seçilmedi" Else DlgText "veritabani", "Veritabanı: " & getFileName(filename, 0) End If End Function Function getFileName(temp_filename As String, temp_type As Boolean) '1 if get the name with any folder info, 0 if only the name Dim temp_length As Integer Dim temp_len_wd As Integer Dim temp_difference As Integer Dim temp_char As String Dim tempfilename As String If temp_type Then temp_len_wd = Len(working_directory ) + 1'get the lenght of the working directory temp_length = Len(temp_filename) 'get the lenght of the file along with the working directory temp_difference = temp_length - temp_len_wd + 1'get the lenght of just the filename getFileName = Mid(temp_filename, temp_len_wd, temp_difference) Else temp_length = Len(temp_filename ) Do temp_char = Mid(temp_filename, temp_length , 1) temp_length = temp_length - 1 If temp_char <> "\" Then tempfilename = temp_char & tempfilename End If Loop Until temp_char = "\" Or temp_length = 0 getFileName = tempfilename End If End Function