mehdi.safavie
پنج شنبه 15 مرداد 1394, 15:08 عصر
اگه سوالی در مورد هر قسمت دارید ، در خدمتم .
ماژول مربوط به کد های SQL
Imports System.IO
Imports System.Data.SqlClient
Module Mod_DataBaseTools
'//tu ghesmate Connection , agar be Data Source meghdare sabeti mesle SQLExPRESS bedid , emkane in hast ke dar system e dige ke barname ro nasb mikonid
'//Instant Name SQLExPRESS nabashe , masalan MSSQL bashe , dar in surat ravande Conecction e shoma ba moshkel movaje mishe
'//pas tu masire exe barname ye file txt besazid ( man esmesh ro Connection gozashtam ) dakhelesh SQLExPRESS ro benevisid va save konid
'//hal agar tu system dg Instant name har chi bud , oun ro be surate dasti tu in ghesmat taghir bedid
'//sharmande rahe digeyi balad nabudam
Private Function DataSource() As String
Dim read As New StreamReader(Application.StartupPath & "\Connection.txt")
DataSource = (read.ReadLine())
read.Close()
End Function
Public Connection As New SqlConnection("Data Source=.\" & DataSource() & ";Integrated Security=True;Initial Catalog=Amlak")
Public Function Backup(ByVal DatabaseName As String, ByVal BackupAddress As String, ByVal BackupName As String) As Boolean
Dim cmd As New SqlClient.SqlCommand()
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim ConnectionString As String = ("Data Source=.\" & Mod_DataBaseTools.DataSource() & ";Integrated Security=True;Initial Catalog=master")
cmd.Connection = Connection
cmd.CommandText = "backup DATABASE [" & DatabaseName & "] to DISK = N'" & BackupAddress & BackupName & ".bak'"
cmd.ExecuteNonQuery()
Connection.Close()
End Function
Public Function Restore(ByVal DatabaseName As String, ByVal RestoreAddress As String, ByVal BackupName As String) As Boolean
Dim cmd As New SqlClient.SqlCommand()
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim ConnectionString As String = ("Data Source=.\" & Mod_DataBaseTools.DataSource() & ";Integrated Security=True;Initial Catalog=master")
cmd.Connection = Connection
cmd.CommandText = "USE MASTER RESTORE DATABASE [" & DatabaseName & "] FROM DISK = N'" & RestoreAddress & BackupName & ".bak'"
cmd.ExecuteNonQuery()
Connection.Close()
End Function
Public Function DeAtach(ByVal DatabaseName As String)
If Mod_DataBaseTools.Check_DB(".\" & DataSource(), DatabaseName) = True Then
Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection
Dim cmd As New SqlClient.SqlCommand()
Dim ConnectionString As String = ("Data Source=.\" & DataSource() & ";Integrated Security=True;Initial Catalog=master")
conn = New SqlClient.SqlConnection
conn.ConnectionString = ConnectionString
conn.Open() 'Open connection
Dim sqlsingoff As String = ("ALTER DATABASE " & DatabaseName & " SET SINGLE_USER WITH ROLLBACK IMMEDIATE")
cmd.CommandText = sqlsingoff
cmd.Connection = conn
cmd.ExecuteNonQuery()
Dim sqlDetech As String = ("sp_detach_db '" & DatabaseName & "', 'true'")
cmd.CommandText = sqlDetech
cmd.Connection = conn
cmd.ExecuteNonQuery()
End If
End Function
Public Function Attach(ByVal DatabaseName As String, ByVal mdfAddress As String, ByVal ldfAddress As String)
Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection
Dim cmd As New SqlClient.SqlCommand()
Dim ConnectionString As String = ("Data Source=.\" & DataSource() & ";Integrated Security=True;Initial Catalog=master")
conn = New SqlClient.SqlConnection
conn.ConnectionString = ConnectionString
conn.Open() 'Open connection
Dim sqlDetech As String = ("EXEC sp_attach_db @dbname='" & DatabaseName & "', @filename1='" & mdfAddress & "' , @filename2='" & ldfAddress & "'")
cmd.CommandText = sqlDetech
cmd.Connection = conn
cmd.ExecuteNonQuery()
conn.Close()
End Function
'ba in Function Check mikoni ke aya Database e morede nazar vojud dare ya na ( Attach hast ya na )
'tu meghdare bRet age True bargardune yani hast
Public Function Check_DB(ByVal server As String, ByVal database As String) As Boolean
Dim connString As String = ("Data Source=" + (server + ";Initial Catalog=master;Integrated Security=True;"))
Dim cmdText As String = _
("select * from master.dbo.sysdatabases where name='" + (database + "'"))
Dim bRet As Boolean = False
Using sqlConnection As SqlConnection = New SqlConnection(connString)
sqlConnection.Open()
Using sqlCmd As SqlCommand = New SqlCommand(cmdText, sqlConnection)
Using reader As SqlDataReader = sqlCmd.ExecuteReader
bRet = reader.HasRows
End Using
End Using
End Using
Return bRet
End Function
'dasturati az ghabile select * from TbName va ...
Public Function SelectCommand(ByVal strCommand As String, ByRef MyDataSet As DataSet, ByVal strTableName As String, Optional ByVal ShowError As Boolean = True) As Boolean
Try
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim dap_tmp As New SqlDataAdapter(strCommand, Connection)
Try
MyDataSet.Tables(strTableName).Clear()
dap_tmp.Fill(MyDataSet, strTableName)
Catch ex As Exception
dap_tmp.Fill(MyDataSet, strTableName)
End Try
SelectCommand = True
Catch ex As Exception
If ShowError = True Then
MsgBox(".خطای زیر در اجرای برنامه رخ داده است" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "خطا")
End If
SelectCommand = False
Finally
Try
Connection.Close()
Catch ex As Exception
' Nothing...
End Try
End Try
End Function
'dasturate Insert va Update va Delete va ....
Public Function ExecuteQuery(ByVal strCommand As String, Optional ByVal ShowError As Boolean = True) As Boolean
Try
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim cmd As New SqlCommand(strCommand, Connection)
cmd.ExecuteNonQuery()
ExecuteQuery = True
Catch ex As Exception
If ShowError = True Then
MsgBox(".خطای زیر در اجرای برنامه رخ داده است" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "خطا")
End If
ExecuteQuery = False
Finally
Try
Connection.Close()
Catch ex As Exception
' Nothing...
End Try
End Try
End Function
'bedast avardane ID jadid baraye Insert
Public Function GetnewID(ByVal strTable As String, ByVal strField As String) As Integer
Try
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim sql_command As String = "select max(" + strField + ") from " + strTable
Dim dap_tmp As New SqlDataAdapter(sql_command, Connection)
Dim dst_tmp As New DataSet
dap_tmp.Fill(dst_tmp, strTable)
Connection.Close()
If dst_tmp.Tables(strTable).Rows(0)(0).ToString() = "" Then
GetnewID = 1
Else
GetnewID = Convert.ToInt32(dst_tmp.Tables(strTable).Rows(0)(0 ).ToString()) + 1
End If
Catch ex As Exception
MsgBox(".خطایی در اجرای برنامه رخ داده است", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "خطا")
GetnewID = 0
End Try
End Function
End Module
ماژول مربوط به بدست آوردن مشخصات سخت افزاری سیستم
Imports System.Management
'//Dim searcher As ManagementObjectSearcher
Imports Microsoft.Win32
Module Mod_HardWare_Informations
'// Read Me
'//Frist Go to Project/Add Refrence/.NET/System.Management and Add This Person To Your Project
Public Function HDD_SerialNumber() As String
HDD_SerialNumber = ""
Dim searcher As ManagementObjectSearcher
Dim query As String = "SELECT * FROM Win32_PhysicalMedia"
searcher = New ManagementObjectSearcher(query)
For Each wmi_HD As ManagementObject In searcher.[Get]()
If wmi_HD("SerialNumber") IsNot Nothing Then
HDD_SerialNumber = wmi_HD("SerialNumber").ToString()
End If
Next
End Function
'in mored ro tu Windows XP test kardam javab nemide Error mide , Havasetun bashe
Public Function HDD_Name() As String
HDD_Name = ""
Dim searcher As ManagementObjectSearcher
Dim query As String = "SELECT * FROM Win32_DiskDrive WHERE BytesPerSector > 0"
searcher = New ManagementObjectSearcher(query)
For Each wmi_HD As ManagementObject In searcher.[Get]()
If wmi_HD("SerialNumber") IsNot Nothing Then
HDD_Name = wmi_HD("SerialNumber").ToString()
End If
Next
End Function
Public Function CPU_Companey() As String
Dim cpuMan As String = String.Empty
'//create an instance of the Managemnet class with the Win32_Processor class
Dim mgmt As ManagementClass = New ManagementClass("Win32_Processor")
'//create a ManagementObjectCollection to loop through
Dim objCol As ManagementObjectCollection = mgmt.GetInstances()
'//start our loop for all processors found
For Each obj As ManagementObject In objCol
If cpuMan = String.Empty Then
' // only return manufacturer from first CPU
cpuMan = obj.Properties("Manufacturer").Value.ToString()
End If
Next
Return cpuMan
End Function
Public Function CPU_Model()
CPU_Model = ""
Dim m_LM As RegistryKey
Dim m_HW As RegistryKey
Dim m_Des As RegistryKey
Dim m_System As RegistryKey
Dim m_CPU As RegistryKey
Dim m_Info As RegistryKey
m_LM = Registry.LocalMachine
m_HW = m_LM.OpenSubKey("HARDWARE")
m_Des = m_HW.OpenSubKey("DESCRIPTION")
m_System = m_Des.OpenSubKey("SYSTEM")
m_CPU = m_System.OpenSubKey("CentralProcessor")
m_Info = m_CPU.OpenSubKey("0")
CPU_Model = (m_Info.GetValue("ProcessorNameString"))
Return CPU_Model
End Function
Public Function CPU_ID() As String
Dim cpuInfo As String = String.Empty
'//create an instance of the Managemnet class with the
'//Win32_Processor class
Dim mgmt As ManagementClass = New ManagementClass("Win32_Processor")
'//create a ManagementObjectCollection to loop through
Dim objCol As ManagementObjectCollection = mgmt.GetInstances()
'//start our loop for all processors found
For Each obj As ManagementObject In objCol
If cpuInfo = String.Empty Then
'// only return cpuInfo from first CPU
cpuInfo = obj.Properties("ProcessorId").Value.ToString()
End If
Next
Return cpuInfo
End Function
Public Function MotherBoard_Name() As String
'get the mother board information
Dim MotherBoardClass As New ManagementClass("Win32_BaseBoard")
Dim MotherBoards As ManagementObjectCollection = MotherBoardClass.GetInstances()
Dim MotherBoardsEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = MotherBoards.GetEnumerator()
MotherBoard_Name = ""
While MotherBoardsEnumerator.MoveNext()
Dim MotherBoard As ManagementObject = CType(MotherBoardsEnumerator.Current, ManagementObject)
MotherBoard_Name = MotherBoard("Manufacturer") & MotherBoard("Model")
End While
Return MotherBoard_Name
End Function
Public Function MotherBoard_SerialNumber() As String
'get the mother board information
Dim MotherBoardClass As New ManagementClass("Win32_BaseBoard")
Dim MotherBoards As ManagementObjectCollection = MotherBoardClass.GetInstances()
Dim MotherBoardsEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = MotherBoards.GetEnumerator()
MotherBoard_SerialNumber = ""
While MotherBoardsEnumerator.MoveNext()
Dim MotherBoard As ManagementObject = CType(MotherBoardsEnumerator.Current, ManagementObject)
MotherBoard_SerialNumber = MotherBoard("SerialNumber")
End While
Return MotherBoard_SerialNumber
End Function
Public Function Bios_ID() As String
'get the bios information
Dim BiosClass As New ManagementClass("Win32_BIOS")
Dim Bioss As ManagementObjectCollection = BiosClass.GetInstances()
Dim BiossEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = Bioss.GetEnumerator()
While BiossEnumerator.MoveNext()
Dim Bios As ManagementObject = CType(BiossEnumerator.Current, ManagementObject)
Bios_ID &= Bios("SerialNumber")
End While
Return Bios_ID
End Function
Public Function Bios_Name() As String
'get the bios information
Dim BiosClass As New ManagementClass("Win32_BIOS")
Dim Bioss As ManagementObjectCollection = BiosClass.GetInstances()
Dim BiossEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = Bioss.GetEnumerator()
While BiossEnumerator.MoveNext()
Dim Bios As ManagementObject = CType(BiossEnumerator.Current, ManagementObject)
Bios_Name &= Bios("Manufacturer")
End While
Return Bios_Name
End Function
Public Function RAM_Companey()
RAM_Companey = ""
Dim searcher As New ManagementObjectSearcher( _
"root\CIMV2", _
"SELECT * FROM Win32_PhysicalMemory")
Dim index As Integer = 0
For Each queryObj As ManagementObject In searcher.Get()
On Error Resume Next
RAM_Companey = (queryObj("Manufacturer") & vbCrLf)
Next
Return RAM_Companey
End Function
Public Function RAM_SerialNumber()
RAM_SerialNumber = ""
Dim searcher As New ManagementObjectSearcher( _
"root\CIMV2", _
"SELECT * FROM Win32_PhysicalMemory")
Dim index As Integer = 0
For Each queryObj As ManagementObject In searcher.Get()
On Error Resume Next
RAM_SerialNumber = (queryObj("SerialNumber") & vbCrLf)
Next
Return RAM_SerialNumber
End Function
Public Function VGA_Info()
VGA_Info = ""
Dim searcher As New ManagementObjectSearcher( _
"root\CIMV2", _
"SELECT * FROM Win32_VideoController")
Dim index As Integer = 0
For Each queryObj As ManagementObject In searcher.Get()
On Error Resume Next
VGA_Info = (queryObj("Name") & vbCrLf)
Next
Return VGA_Info
End Function
End Module
ماژول مربوط به زیپ کردن و آنزیپ کردن فایل ها و فولدر ها ( dll های مربوط رو تو ضمیمه همین پست آپلود کردم
Imports System
Imports ComponentAce.Compression.ZipForge
Imports ComponentAce.Compression.Archiver
Module Mod_Zipper
Public Function ZipFiles(ByRef BaseAddress As String, ByRef EndAddress As String)
' Create an instance of the ZipForge class
Dim archiver As New ZipForge()
Try
'esm va addrese fili ke gharare zip beshe
archiver.FileName = EndAddress & ".zip"
' Because we create a new archive,
' we set fileMode to System.IO.FileMode.Create
archiver.OpenArchive(System.IO.FileMode.Create)
' Add files to the archive by mask
archiver.AddFiles(BaseAddress)
archiver.CloseArchive()
' Catch all exceptions of the ArchiverException type
Catch ae As ArchiverException
MsgBox("Message: {0} Error code: {1}" & ae.Message, ae.ErrorCode)
End Try
End Function
Public Function UnZippAll(ByRef BaseAddress As String, ByRef EndAddress As String)
Dim archiver As New ZipForge()
Try
'esm va adrese file zipi ke gharare UnZip beshe
archiver.FileName = BaseAddress
' Open an existing archive
archiver.OpenArchive(System.IO.FileMode.Open)
'adrese jayi ke zip bayad Extract beshe
archiver.BaseDir = EndAddress
'harchi ke tu file zip hast extract mikone tu addrese basi ke bala dadim
archiver.ExtractFiles("*.*")
' Close archive
archiver.CloseArchive()
' Catch all exceptions of the ArchiverException type
Catch ae As ArchiverException
MsgBox("Message: {0} Error code: {1}" & ae.Message, ae.ErrorCode)
End Try
End Function
Public Function ZipFolder(ByRef BaseAddress As String, ByRef EndAddress As String)
' Create an instance of the ZipForge class
Dim archiver As New ZipForge()
Try
archiver.FileName = EndAddress & ".zip"
archiver.OpenArchive(System.IO.FileMode.Create)
archiver.BaseDir = BaseAddress
archiver.AddFiles(BaseAddress)
archiver.CloseArchive()
Catch ae As ArchiverException
MsgBox("Message: {0} Error code: {1}" & ae.Message, ae.ErrorCode)
End Try
End Function
End Module
ماژول مربوط به تغییر زبان و بدست آوردن زبان کیبورد
Module Mod_Languache
Public FaLanguage As New Globalization.CultureInfo("fa-IR")
Public EnLanguage As New Globalization.CultureInfo("En-US")
Public mylanguage As InputLanguage
'//taghir be zabane Persian
Public Function fa()
InputLanguage.CurrentInputLanguage = mylanguage.FromCulture(FaLanguage)
End Function
'//taghir be zabane English
Public Function en()
InputLanguage.CurrentInputLanguage = mylanguage.FromCulture(EnLanguage)
End Function
'//bedast avardane zabane feli
Public Function name() As String
name = InputLanguage.CurrentInputLanguage.LayoutName
End Function
End Module
ماژول مربوط به کار با فایل ها
Imports System.IO
Module Mod_File
'//neveshtan dar yek file txt
'//agar meghdare StreamWriter , parametre dovom True bashe , be surate Append zakhire mikone
Public Function Wright(ByVal WriteAddress As String, ByVal FileText As String)
Dim IOFile As New StreamWriter(WriteAddress, False)
IOFile.WriteLine(FileText)
IOFile.Close()
End Function
'//khandan az yek file txt
Public Function ReadFile(ByVal ReadAddress As String, ByVal FileText As String)
Dim read As New StreamReader(ReadAddress)
FileText = (read.ReadLine())
read.Close()
End Function
Public Function RenameFile(ByVal RenameAddress As String, ByVal RenameFileName As String)
My.Computer.FileSystem.RenameFile(RenameAddress, RenameFileName)
End Function
Public Function RenameFolder(ByVal RenameAddress As String, ByVal RenameFolderName As String)
My.Computer.FileSystem.RenameDirectory(RenameAddre ss, RenameFolderName)
End Function
Public Function DeleteFile(ByVal DeleteAddress As String)
My.Computer.FileSystem.DeleteFile(DeleteAddress)
End Function
Public Function DeleteFolder(ByVal DeleteAddress As String)
My.Computer.FileSystem.DeleteDirectory(DeleteAddre ss, FileIO.DeleteDirectoryOption.DeleteAllContents)
End Function
Public Function ExistFile(ByVal ExistAddress As String) As Boolean
If My.Computer.FileSystem.FileExists(ExistAddress) = True Then
ExistFile = True
Else
ExistFile = False
End If
End Function
Public Function ExistFolder(ByVal ExistAddress As String) As Boolean
If My.Computer.FileSystem.DirectoryExists(ExistAddres s) = True Then
ExistFolder = True
Else
ExistFolder = False
End If
End Function
End Module
ماژول مربوط به کد های SQL
Imports System.IO
Imports System.Data.SqlClient
Module Mod_DataBaseTools
'//tu ghesmate Connection , agar be Data Source meghdare sabeti mesle SQLExPRESS bedid , emkane in hast ke dar system e dige ke barname ro nasb mikonid
'//Instant Name SQLExPRESS nabashe , masalan MSSQL bashe , dar in surat ravande Conecction e shoma ba moshkel movaje mishe
'//pas tu masire exe barname ye file txt besazid ( man esmesh ro Connection gozashtam ) dakhelesh SQLExPRESS ro benevisid va save konid
'//hal agar tu system dg Instant name har chi bud , oun ro be surate dasti tu in ghesmat taghir bedid
'//sharmande rahe digeyi balad nabudam
Private Function DataSource() As String
Dim read As New StreamReader(Application.StartupPath & "\Connection.txt")
DataSource = (read.ReadLine())
read.Close()
End Function
Public Connection As New SqlConnection("Data Source=.\" & DataSource() & ";Integrated Security=True;Initial Catalog=Amlak")
Public Function Backup(ByVal DatabaseName As String, ByVal BackupAddress As String, ByVal BackupName As String) As Boolean
Dim cmd As New SqlClient.SqlCommand()
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim ConnectionString As String = ("Data Source=.\" & Mod_DataBaseTools.DataSource() & ";Integrated Security=True;Initial Catalog=master")
cmd.Connection = Connection
cmd.CommandText = "backup DATABASE [" & DatabaseName & "] to DISK = N'" & BackupAddress & BackupName & ".bak'"
cmd.ExecuteNonQuery()
Connection.Close()
End Function
Public Function Restore(ByVal DatabaseName As String, ByVal RestoreAddress As String, ByVal BackupName As String) As Boolean
Dim cmd As New SqlClient.SqlCommand()
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim ConnectionString As String = ("Data Source=.\" & Mod_DataBaseTools.DataSource() & ";Integrated Security=True;Initial Catalog=master")
cmd.Connection = Connection
cmd.CommandText = "USE MASTER RESTORE DATABASE [" & DatabaseName & "] FROM DISK = N'" & RestoreAddress & BackupName & ".bak'"
cmd.ExecuteNonQuery()
Connection.Close()
End Function
Public Function DeAtach(ByVal DatabaseName As String)
If Mod_DataBaseTools.Check_DB(".\" & DataSource(), DatabaseName) = True Then
Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection
Dim cmd As New SqlClient.SqlCommand()
Dim ConnectionString As String = ("Data Source=.\" & DataSource() & ";Integrated Security=True;Initial Catalog=master")
conn = New SqlClient.SqlConnection
conn.ConnectionString = ConnectionString
conn.Open() 'Open connection
Dim sqlsingoff As String = ("ALTER DATABASE " & DatabaseName & " SET SINGLE_USER WITH ROLLBACK IMMEDIATE")
cmd.CommandText = sqlsingoff
cmd.Connection = conn
cmd.ExecuteNonQuery()
Dim sqlDetech As String = ("sp_detach_db '" & DatabaseName & "', 'true'")
cmd.CommandText = sqlDetech
cmd.Connection = conn
cmd.ExecuteNonQuery()
End If
End Function
Public Function Attach(ByVal DatabaseName As String, ByVal mdfAddress As String, ByVal ldfAddress As String)
Dim conn As SqlClient.SqlConnection = New SqlClient.SqlConnection
Dim cmd As New SqlClient.SqlCommand()
Dim ConnectionString As String = ("Data Source=.\" & DataSource() & ";Integrated Security=True;Initial Catalog=master")
conn = New SqlClient.SqlConnection
conn.ConnectionString = ConnectionString
conn.Open() 'Open connection
Dim sqlDetech As String = ("EXEC sp_attach_db @dbname='" & DatabaseName & "', @filename1='" & mdfAddress & "' , @filename2='" & ldfAddress & "'")
cmd.CommandText = sqlDetech
cmd.Connection = conn
cmd.ExecuteNonQuery()
conn.Close()
End Function
'ba in Function Check mikoni ke aya Database e morede nazar vojud dare ya na ( Attach hast ya na )
'tu meghdare bRet age True bargardune yani hast
Public Function Check_DB(ByVal server As String, ByVal database As String) As Boolean
Dim connString As String = ("Data Source=" + (server + ";Initial Catalog=master;Integrated Security=True;"))
Dim cmdText As String = _
("select * from master.dbo.sysdatabases where name='" + (database + "'"))
Dim bRet As Boolean = False
Using sqlConnection As SqlConnection = New SqlConnection(connString)
sqlConnection.Open()
Using sqlCmd As SqlCommand = New SqlCommand(cmdText, sqlConnection)
Using reader As SqlDataReader = sqlCmd.ExecuteReader
bRet = reader.HasRows
End Using
End Using
End Using
Return bRet
End Function
'dasturati az ghabile select * from TbName va ...
Public Function SelectCommand(ByVal strCommand As String, ByRef MyDataSet As DataSet, ByVal strTableName As String, Optional ByVal ShowError As Boolean = True) As Boolean
Try
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim dap_tmp As New SqlDataAdapter(strCommand, Connection)
Try
MyDataSet.Tables(strTableName).Clear()
dap_tmp.Fill(MyDataSet, strTableName)
Catch ex As Exception
dap_tmp.Fill(MyDataSet, strTableName)
End Try
SelectCommand = True
Catch ex As Exception
If ShowError = True Then
MsgBox(".خطای زیر در اجرای برنامه رخ داده است" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "خطا")
End If
SelectCommand = False
Finally
Try
Connection.Close()
Catch ex As Exception
' Nothing...
End Try
End Try
End Function
'dasturate Insert va Update va Delete va ....
Public Function ExecuteQuery(ByVal strCommand As String, Optional ByVal ShowError As Boolean = True) As Boolean
Try
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim cmd As New SqlCommand(strCommand, Connection)
cmd.ExecuteNonQuery()
ExecuteQuery = True
Catch ex As Exception
If ShowError = True Then
MsgBox(".خطای زیر در اجرای برنامه رخ داده است" & vbCrLf & ex.Message, MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "خطا")
End If
ExecuteQuery = False
Finally
Try
Connection.Close()
Catch ex As Exception
' Nothing...
End Try
End Try
End Function
'bedast avardane ID jadid baraye Insert
Public Function GetnewID(ByVal strTable As String, ByVal strField As String) As Integer
Try
If Connection.State = ConnectionState.Closed Then
Connection.Open()
End If
Dim sql_command As String = "select max(" + strField + ") from " + strTable
Dim dap_tmp As New SqlDataAdapter(sql_command, Connection)
Dim dst_tmp As New DataSet
dap_tmp.Fill(dst_tmp, strTable)
Connection.Close()
If dst_tmp.Tables(strTable).Rows(0)(0).ToString() = "" Then
GetnewID = 1
Else
GetnewID = Convert.ToInt32(dst_tmp.Tables(strTable).Rows(0)(0 ).ToString()) + 1
End If
Catch ex As Exception
MsgBox(".خطایی در اجرای برنامه رخ داده است", MsgBoxStyle.OkOnly + MsgBoxStyle.Critical, "خطا")
GetnewID = 0
End Try
End Function
End Module
ماژول مربوط به بدست آوردن مشخصات سخت افزاری سیستم
Imports System.Management
'//Dim searcher As ManagementObjectSearcher
Imports Microsoft.Win32
Module Mod_HardWare_Informations
'// Read Me
'//Frist Go to Project/Add Refrence/.NET/System.Management and Add This Person To Your Project
Public Function HDD_SerialNumber() As String
HDD_SerialNumber = ""
Dim searcher As ManagementObjectSearcher
Dim query As String = "SELECT * FROM Win32_PhysicalMedia"
searcher = New ManagementObjectSearcher(query)
For Each wmi_HD As ManagementObject In searcher.[Get]()
If wmi_HD("SerialNumber") IsNot Nothing Then
HDD_SerialNumber = wmi_HD("SerialNumber").ToString()
End If
Next
End Function
'in mored ro tu Windows XP test kardam javab nemide Error mide , Havasetun bashe
Public Function HDD_Name() As String
HDD_Name = ""
Dim searcher As ManagementObjectSearcher
Dim query As String = "SELECT * FROM Win32_DiskDrive WHERE BytesPerSector > 0"
searcher = New ManagementObjectSearcher(query)
For Each wmi_HD As ManagementObject In searcher.[Get]()
If wmi_HD("SerialNumber") IsNot Nothing Then
HDD_Name = wmi_HD("SerialNumber").ToString()
End If
Next
End Function
Public Function CPU_Companey() As String
Dim cpuMan As String = String.Empty
'//create an instance of the Managemnet class with the Win32_Processor class
Dim mgmt As ManagementClass = New ManagementClass("Win32_Processor")
'//create a ManagementObjectCollection to loop through
Dim objCol As ManagementObjectCollection = mgmt.GetInstances()
'//start our loop for all processors found
For Each obj As ManagementObject In objCol
If cpuMan = String.Empty Then
' // only return manufacturer from first CPU
cpuMan = obj.Properties("Manufacturer").Value.ToString()
End If
Next
Return cpuMan
End Function
Public Function CPU_Model()
CPU_Model = ""
Dim m_LM As RegistryKey
Dim m_HW As RegistryKey
Dim m_Des As RegistryKey
Dim m_System As RegistryKey
Dim m_CPU As RegistryKey
Dim m_Info As RegistryKey
m_LM = Registry.LocalMachine
m_HW = m_LM.OpenSubKey("HARDWARE")
m_Des = m_HW.OpenSubKey("DESCRIPTION")
m_System = m_Des.OpenSubKey("SYSTEM")
m_CPU = m_System.OpenSubKey("CentralProcessor")
m_Info = m_CPU.OpenSubKey("0")
CPU_Model = (m_Info.GetValue("ProcessorNameString"))
Return CPU_Model
End Function
Public Function CPU_ID() As String
Dim cpuInfo As String = String.Empty
'//create an instance of the Managemnet class with the
'//Win32_Processor class
Dim mgmt As ManagementClass = New ManagementClass("Win32_Processor")
'//create a ManagementObjectCollection to loop through
Dim objCol As ManagementObjectCollection = mgmt.GetInstances()
'//start our loop for all processors found
For Each obj As ManagementObject In objCol
If cpuInfo = String.Empty Then
'// only return cpuInfo from first CPU
cpuInfo = obj.Properties("ProcessorId").Value.ToString()
End If
Next
Return cpuInfo
End Function
Public Function MotherBoard_Name() As String
'get the mother board information
Dim MotherBoardClass As New ManagementClass("Win32_BaseBoard")
Dim MotherBoards As ManagementObjectCollection = MotherBoardClass.GetInstances()
Dim MotherBoardsEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = MotherBoards.GetEnumerator()
MotherBoard_Name = ""
While MotherBoardsEnumerator.MoveNext()
Dim MotherBoard As ManagementObject = CType(MotherBoardsEnumerator.Current, ManagementObject)
MotherBoard_Name = MotherBoard("Manufacturer") & MotherBoard("Model")
End While
Return MotherBoard_Name
End Function
Public Function MotherBoard_SerialNumber() As String
'get the mother board information
Dim MotherBoardClass As New ManagementClass("Win32_BaseBoard")
Dim MotherBoards As ManagementObjectCollection = MotherBoardClass.GetInstances()
Dim MotherBoardsEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = MotherBoards.GetEnumerator()
MotherBoard_SerialNumber = ""
While MotherBoardsEnumerator.MoveNext()
Dim MotherBoard As ManagementObject = CType(MotherBoardsEnumerator.Current, ManagementObject)
MotherBoard_SerialNumber = MotherBoard("SerialNumber")
End While
Return MotherBoard_SerialNumber
End Function
Public Function Bios_ID() As String
'get the bios information
Dim BiosClass As New ManagementClass("Win32_BIOS")
Dim Bioss As ManagementObjectCollection = BiosClass.GetInstances()
Dim BiossEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = Bioss.GetEnumerator()
While BiossEnumerator.MoveNext()
Dim Bios As ManagementObject = CType(BiossEnumerator.Current, ManagementObject)
Bios_ID &= Bios("SerialNumber")
End While
Return Bios_ID
End Function
Public Function Bios_Name() As String
'get the bios information
Dim BiosClass As New ManagementClass("Win32_BIOS")
Dim Bioss As ManagementObjectCollection = BiosClass.GetInstances()
Dim BiossEnumerator As ManagementObjectCollection.ManagementObjectEnumera tor = Bioss.GetEnumerator()
While BiossEnumerator.MoveNext()
Dim Bios As ManagementObject = CType(BiossEnumerator.Current, ManagementObject)
Bios_Name &= Bios("Manufacturer")
End While
Return Bios_Name
End Function
Public Function RAM_Companey()
RAM_Companey = ""
Dim searcher As New ManagementObjectSearcher( _
"root\CIMV2", _
"SELECT * FROM Win32_PhysicalMemory")
Dim index As Integer = 0
For Each queryObj As ManagementObject In searcher.Get()
On Error Resume Next
RAM_Companey = (queryObj("Manufacturer") & vbCrLf)
Next
Return RAM_Companey
End Function
Public Function RAM_SerialNumber()
RAM_SerialNumber = ""
Dim searcher As New ManagementObjectSearcher( _
"root\CIMV2", _
"SELECT * FROM Win32_PhysicalMemory")
Dim index As Integer = 0
For Each queryObj As ManagementObject In searcher.Get()
On Error Resume Next
RAM_SerialNumber = (queryObj("SerialNumber") & vbCrLf)
Next
Return RAM_SerialNumber
End Function
Public Function VGA_Info()
VGA_Info = ""
Dim searcher As New ManagementObjectSearcher( _
"root\CIMV2", _
"SELECT * FROM Win32_VideoController")
Dim index As Integer = 0
For Each queryObj As ManagementObject In searcher.Get()
On Error Resume Next
VGA_Info = (queryObj("Name") & vbCrLf)
Next
Return VGA_Info
End Function
End Module
ماژول مربوط به زیپ کردن و آنزیپ کردن فایل ها و فولدر ها ( dll های مربوط رو تو ضمیمه همین پست آپلود کردم
Imports System
Imports ComponentAce.Compression.ZipForge
Imports ComponentAce.Compression.Archiver
Module Mod_Zipper
Public Function ZipFiles(ByRef BaseAddress As String, ByRef EndAddress As String)
' Create an instance of the ZipForge class
Dim archiver As New ZipForge()
Try
'esm va addrese fili ke gharare zip beshe
archiver.FileName = EndAddress & ".zip"
' Because we create a new archive,
' we set fileMode to System.IO.FileMode.Create
archiver.OpenArchive(System.IO.FileMode.Create)
' Add files to the archive by mask
archiver.AddFiles(BaseAddress)
archiver.CloseArchive()
' Catch all exceptions of the ArchiverException type
Catch ae As ArchiverException
MsgBox("Message: {0} Error code: {1}" & ae.Message, ae.ErrorCode)
End Try
End Function
Public Function UnZippAll(ByRef BaseAddress As String, ByRef EndAddress As String)
Dim archiver As New ZipForge()
Try
'esm va adrese file zipi ke gharare UnZip beshe
archiver.FileName = BaseAddress
' Open an existing archive
archiver.OpenArchive(System.IO.FileMode.Open)
'adrese jayi ke zip bayad Extract beshe
archiver.BaseDir = EndAddress
'harchi ke tu file zip hast extract mikone tu addrese basi ke bala dadim
archiver.ExtractFiles("*.*")
' Close archive
archiver.CloseArchive()
' Catch all exceptions of the ArchiverException type
Catch ae As ArchiverException
MsgBox("Message: {0} Error code: {1}" & ae.Message, ae.ErrorCode)
End Try
End Function
Public Function ZipFolder(ByRef BaseAddress As String, ByRef EndAddress As String)
' Create an instance of the ZipForge class
Dim archiver As New ZipForge()
Try
archiver.FileName = EndAddress & ".zip"
archiver.OpenArchive(System.IO.FileMode.Create)
archiver.BaseDir = BaseAddress
archiver.AddFiles(BaseAddress)
archiver.CloseArchive()
Catch ae As ArchiverException
MsgBox("Message: {0} Error code: {1}" & ae.Message, ae.ErrorCode)
End Try
End Function
End Module
ماژول مربوط به تغییر زبان و بدست آوردن زبان کیبورد
Module Mod_Languache
Public FaLanguage As New Globalization.CultureInfo("fa-IR")
Public EnLanguage As New Globalization.CultureInfo("En-US")
Public mylanguage As InputLanguage
'//taghir be zabane Persian
Public Function fa()
InputLanguage.CurrentInputLanguage = mylanguage.FromCulture(FaLanguage)
End Function
'//taghir be zabane English
Public Function en()
InputLanguage.CurrentInputLanguage = mylanguage.FromCulture(EnLanguage)
End Function
'//bedast avardane zabane feli
Public Function name() As String
name = InputLanguage.CurrentInputLanguage.LayoutName
End Function
End Module
ماژول مربوط به کار با فایل ها
Imports System.IO
Module Mod_File
'//neveshtan dar yek file txt
'//agar meghdare StreamWriter , parametre dovom True bashe , be surate Append zakhire mikone
Public Function Wright(ByVal WriteAddress As String, ByVal FileText As String)
Dim IOFile As New StreamWriter(WriteAddress, False)
IOFile.WriteLine(FileText)
IOFile.Close()
End Function
'//khandan az yek file txt
Public Function ReadFile(ByVal ReadAddress As String, ByVal FileText As String)
Dim read As New StreamReader(ReadAddress)
FileText = (read.ReadLine())
read.Close()
End Function
Public Function RenameFile(ByVal RenameAddress As String, ByVal RenameFileName As String)
My.Computer.FileSystem.RenameFile(RenameAddress, RenameFileName)
End Function
Public Function RenameFolder(ByVal RenameAddress As String, ByVal RenameFolderName As String)
My.Computer.FileSystem.RenameDirectory(RenameAddre ss, RenameFolderName)
End Function
Public Function DeleteFile(ByVal DeleteAddress As String)
My.Computer.FileSystem.DeleteFile(DeleteAddress)
End Function
Public Function DeleteFolder(ByVal DeleteAddress As String)
My.Computer.FileSystem.DeleteDirectory(DeleteAddre ss, FileIO.DeleteDirectoryOption.DeleteAllContents)
End Function
Public Function ExistFile(ByVal ExistAddress As String) As Boolean
If My.Computer.FileSystem.FileExists(ExistAddress) = True Then
ExistFile = True
Else
ExistFile = False
End If
End Function
Public Function ExistFolder(ByVal ExistAddress As String) As Boolean
If My.Computer.FileSystem.DirectoryExists(ExistAddres s) = True Then
ExistFolder = True
Else
ExistFolder = False
End If
End Function
End Module