Favorilerine Ekle | Giriş Sayfan Yap | Tavsiye Et

 

Kurs Tanıtım Sayfası | Süper Üye Kimdir? | Menü Tasarımı Konulu Örnek Ders
Kod İndir| Hazır Kodlar | Makaleler| İpuçları | VB .NET Kursu | Dersler | Forum | Alt Bölümler | Servisler
    Merhaba Misafir
    anasayfa » visual basic makaleleri » Setup`ı bir dosya haline getirme
Üye Girişi
Kullanıcı Adı:  
Şifre : 
Kaydet ?
Siteden tam olarak faydalanabilmek için üye olmalısınız.
Unuttuğunuz şifrenizi öğrenebilmek için kayıt sırasında verdiğiniz Hatırlatma Cevabı'nı bilmeniz gereklidir.
Şifre hatırlatma işlevini sadece 3 defa kullanma hakkınız vardır.
Kullanıcı adını ve şifresini unutan üyelere email ile yardım verilmez.

Aktivasyon Gelmedi mi?Aktivasyon mesajınız email adresinize gelmedi mi?
Buraya tıklayarak bir kez daha aktivasyon mesajı gönderilmesini sağlayabilirsiniz.
Lütfen email hesabınızın BULK ve SPAM klasörlerini de kontrol ediniz.
Rastgele Makale

Reklam Formları

Yazar: sparow

Webmasterlar
Sitenize Ekleyin!
Sitenizde "Son Eklenen 10 Visual Basic Yazısı"'nı göstermek ve içeriğini zenginleştirmek için buraya tıklayınız.

Vbasicmaster.com'a link verin!
Aşağıdaki minik banneri sitenize eklemek için tıklayın!

Üye Sayısı:
Ziyaretçiler nerede?
Yayın № : 11480
Yayın Tar:31.05.2009
Yazar : huseyinren
Hit :2089

Bu Yazarın Yazıları Sadece bu yazarın makale göster
Bu Yazıyı Tavsiye Et

‘ Bu program sayesinde vb 6 ile hazırladığımız setup dosyasını tek bir dosya haline getirip sonra müşteriye veriyoruz bu program hem müşteri bilgisayar disk Numansına bakıp kuruluma devam ediyor yok eğer disk seri numarası farklı ise kurulum yapılmıyor program kendini kapatıyor. Böylece programımız için bir nebze de olsa başka bir bilgisayara kurulmasını engellemiş oluruz.
‘ öncelikle bir proje açıyoruz proje adı kurulum olsun ardında form`a yukle ve cikis adında 2 adet buton, bir adet Timer , Label ve bir de resource componenti ekleyin resource komponentinin içine bizim daha önce vb 6 ile hazırladığımız kurulum dosyalarını içine atacağız ve böylece bu dosyalarını bir exe dosyası içerisine gömeceğiz ki setup`ımız tek bir dosya haline gelecek hem de kurulurken güvenlik amaçlı olarak disk serial numarasına bakacak ve bizim istemediğimiz bir bilgisayara kurulursa program kurulumu iptal edip kapanacak


Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Sub Form_Load()
On Error Resume Next
Dim drvNumber As Long
Dim serial
serial = Trim$(GetDriveInfo(drvNumber).SerialNumber)
If serial <> "XXX" And serial <> "XXXX XXXX" Then

‘ yukarıdaki XXX sizin hardisk seri numarası, XXXX XXXX ise kurulacak bilgisayarın hardisk seri numarsıdır böylece hem sizin hem de kurulum yapılacak bilgisayarda sorun çıkarmadan kurulum yapılacaktır, eğer disk numarası uyumlu değilse mesajı verecek ve kapanacak
MsgBox "Kur Bilgisyarı Tanımlayamadı.. Program Kurulumu İptal Edilecek", vbCritical, "Kur Yükleme Hatası"
End
Else
End If
End Sub

Private Sub Timer1_Timer()
‘Timer1 in interval değerini 1000 yapın
Enabled özelliğini False yapın ve Label1.Caption 120 yapın böylece programımıza kurulum zamanı vermiş oluruz ve 2 dakika sonra temp klasöründeki setup dosyalarımız otomatik olarak bu süre sonunda silinecektir, tabi siz farklı bir yol yapabilirsiniz, Yükle Butonuna tıklandığında timer1 çalışacak süre somunda label1.caption o`a eşit olduğunda program kapanacak ve temp klasöründeki dosyaları silicektir
Label1.Caption = Label1.Caption - 1
If Label1.Caption = 0 Then
Cikis_CLick
Else
End If
End Sub

Private Sub yukle_Click()

‘ Resource Editor yardımıyla vb ile setup haline getirdiğimiz dosyaları Resource Editör`üne atıyoruz
On Error Resume Next

'Aşağıdaki komut yarmıyla yukle butonuna tıkladndığında formumuzu gizliyoruz

Form1.Visible = False

Dim resbytes() As Byte
resbytes = LoadResData(102, "CUSTOM")
Dim no As Byte
no = FreeFile
Open GetTempPath & "\programım.cab" For Binary As #no
Put #no, , resbytes
Close #no

Dim resbytes1() As Byte
resbytes1 = LoadResData(103, "CUSTOM")
Dim no1 As Byte
no1 = FreeFile
Open GetTempPath & "\setup.lst" For Binary As #no1
Put #no1, , resbytes1
Close #no1

Dim resbytes2() As Byte
resbytes2 = LoadResData(101, "CUSTOM")
Dim no2 As Byte
no2 = FreeFile
Open GetTempPath & "\setup.exe" For Binary As #no2
Put #no2, , resbytes2
Close #no2

'aşağıdaki komut yramıyla temp dizinine açtığımız dosya yı çalıştırıyoruz

Shell GetTempPath & "\setup.exe", vbNormalFocus
Timer1.Enabled=True
End Sub

Private Sub cikis_Click()
On Error Resume Next
‘ Eğer Çıkış Butonu tıklanırsa temp klasörüne açılan dosyalar silinecek ve program kapanacak
Kill GetTempPath & "\setup.exe"
Kill GetTempPath & "\setup.lst"
Kill GetTempPath & "\ programım.cab"

End
End Sub

Bir modul ekleyin aşağıdaki kodları yapıştırın, bu modül sayesinde temp dizinini öğrenip res dosyasını oraya çıkartıyoruz
Bas modülün adını da GetTemp olsun ve aşağıdaki kodları bu modüle ekleyin
Option Explicit
Private Declare Function GetTempFileNameAPI Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPathAPI Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function VBSysDir() As String
' Sistem Dizinini Öğrenmek
Dim Gwdvar As String, Gwdvar_Length As Integer
Gwdvar = Space(255)
Gwdvar_Length = GetSystemDirectory(Gwdvar, 255)
VBSysDir = Left(Gwdvar, Gwdvar_Length)
End Function
Public Function GetTempPath() As String
Dim strBuffer As String '
strBuffer = Space(255)
GetTempPathAPI Len(strBuffer), strBuffer
GetTempPath = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
End Function
Public Function GetTempFileName(strPrefix As String) As String
Dim strBuffer As String
strBuffer = Space(255)
GetTempFileNameAPI GetTempPath, strPrefix, 0, strBuffer
GetTempFileName = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
End Function
Public Function LoadFile(strResourceList As String, lResourceID As Long) As String
Dim arrByteData() As Byte
Dim lFileNumber As Long
Dim strTempFile As String '
arrByteData = LoadResData(lResourceID, strResourceList)
lFileNumber = FreeFile
strTempFile = GetTempFileName("TF") '
Open strTempFile For Binary Access Write As lFileNumber
Put lFileNumber, , arrByteData
Close lFileNumber
LoadFile = strTempFile
End Function
Ve bir modül daha ekleyelim adını da diskserial olsun ardında da aşağıdaki kodları bu modüle yapıştıralım be modül sayesinde daha önce programımızı kuracağımız bilgisayarın disk serial numarasını öğrendiğimiz disk seri numarasını ( Fabrika Seri No ) tespit ediyoruz ki başka bilgisayara kurulmasını engelle4miş oluruz.
Option Explicit

Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const OPEN_EXISTING = 3
Public Const CREATE_NEW = 1
Public Const INVALID_HANDLE_VALUE = -1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const IDENTIFY_BUFFER_SIZE = 512
Public Const OUTPUT_DATA_SIZE = IDENTIFY_BUFFER_SIZE + 16
Public Type GETVERSIONOUTPARAMS
bVersion As Byte
bRevision As Byte
bReserved As Byte '
bIDEDeviceMap As Byte '
fCapabilities As Long '
dwReserved(3) As Long '
End Type

Public Type IDEREGS
bFeaturesReg As Byte
bSectorCountReg As Byte
bSectorNumberReg As Byte '
bCylLowReg As Byte
bCylHighReg As Byte
bDriveHeadReg As Byte
bCommandReg As Byte '
bReserved As Byte
End Type

Public Type SENDCMDINPARAMS
cBufferSize As Long
irDriveRegs As IDEREGS
bDriveNumber As Byte
bReserved(2) As Byte
dwReserved(3) As Long
bBuffer() As Byte
End Type

Public Const IDE_ID_FUNCTION = &HEC
Public Const IDE_EXECUTE_SMART_FUNCTION = &HB0
Public Const SMART_CYL_LOW = &H4F
Public Const SMART_CYL_HI = &HC2

Public Type DRIVERSTATUS
bDriverError As Byte
bIDEStatus As Byte

bReserved(1) As Byte
dwReserved(1) As Long
End Type

Public Type IDSECTOR
wGenConfig As Integer
wNumCyls As Integer
wReserved As Integer
wNumHeads As Integer
wBytesPerTrack As Integer
wBytesPerSector As Integer
wSectorsPerTrack As Integer
wVendorUnique(2) As Integer
sSerialNumber(19) As Byte
wBufferType As Integer
wBufferSize As Integer
wECCSize As Integer
sFirmwareRev(7) As Byte
sModelNumber(39) As Byte
wMoreVendorUnique As Integer
wDoubleWordIO As Integer
wCapabilities As Integer
wReserved1 As Integer
wPIOTiming As Integer
wDMATiming As Integer
wBS As Integer
wNumCurrentCyls As Integer
wNumCurrentHeads As Integer
wNumCurrentSectorsPerTrack As Integer
ulCurrentSectorCapacity As Long
wMultSectorStuff As Integer
ulTotalAddressableSectors As Long
wSingleWordDMA As Integer
wMultiWordDMA As Integer
bReserved(127) As Byte
End Type

Public Type SENDCMDOUTPARAMS
cBufferSize As Long
DRIVERSTATUS As DRIVERSTATUS
bBuffer() As Byte
End Type

Public Const SMART_ENABLE_SMART_OPERATIONS = &HD8

Public Enum STATUS_FLAGS
PRE_FAILURE_WARRANTY = &H1
ON_LINE_COLLECTION = &H2
PERFORMANCE_ATTRIBUTE = &H4
ERROR_RATE_ATTRIBUTE = &H8
EVENT_COUNT_ATTRIBUTE = &H10
SELF_PRESERVING_ATTRIBUTE = &H20
End Enum

Public Const DFP_GET_VERSION = &H74080
Public Const DFP_SEND_DRIVE_COMMAND = &H7C084
Public Const DFP_RECEIVE_DRIVE_DATA = &H7C088

Public Type ATTR_DATA
AttrID As Byte
AttrName As String
AttrValue As Byte
ThresholdValue As Byte
WorstValue As Byte
StatusFlags As STATUS_FLAGS
End Type

Public Type DRIVE_INFO
bDriveType As Byte
SerialNumber As String
Model As String
FirmWare As String
Cilinders As Long
Heads As Long
SecPerTrack As Long
BytesPerSector As Long
BytesperTrack As Long
NumAttributes As Byte
Attributes() As ATTR_DATA
End Type

Public Enum IDE_DRIVE_NUMBER
PRIMARY_MASTER
PRIMARY_SLAVE
SECONDARY_MASTER
SECONDARY_SLAVE
TERTIARY_MASTER
TERTIARY_SLAVE
QUARTIARY_MASTER
QUARTIARY_SLAVE
End Enum

Public Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Public Declare Function DeviceIoControl Lib "kernel32" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
lpInBuffer As Any, _
ByVal nInBufferSize As Long, _
lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
lpBytesReturned As Long, _
lpOverlapped As Any) As Long

Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)

Public Type OSVERSIONINFO
OSVSize As Long
dwVerMajor As Long
dwVerMinor As Long
dwBuildNumber As Long
PlatformID As Long
szCSDVersion As String * 128
End Type

Public Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" _
(LpVersionInformation As OSVERSIONINFO) As Long
Public Function GetDriveInfo(drvNumber As IDE_DRIVE_NUMBER) As DRIVE_INFO

Dim hDrive As Long
Dim di As DRIVE_INFO

hDrive = SmartOpen(drvNumber)

If hDrive <> INVALID_HANDLE_VALUE Then

If SmartGetVersion(hDrive) = True Then

With di
.bDriveType = 0
.NumAttributes = 0
ReDim .Attributes(0)
.bDriveType = 1
End With

If SmartCheckEnabled(hDrive, drvNumber) Then

If IdentifyDrive(hDrive, IDE_ID_FUNCTION, drvNumber, di) = True Then

GetDriveInfo = di

End If
End If
End If
End If

CloseHandle hDrive

End Function


Public Function IdentifyDrive(ByVal hDrive As Long, _
ByVal IDCmd As Byte, _
ByVal drvNumber As IDE_DRIVE_NUMBER, _
di As DRIVE_INFO) As Boolean

Dim SCIP As SENDCMDINPARAMS
Dim IDSEC As IDSECTOR
Dim bArrOut(OUTPUT_DATA_SIZE - 1) As Byte
Dim cbBytesReturned As Long

With SCIP
.cBufferSize = IDENTIFY_BUFFER_SIZE
.bDriveNumber = CByte(drvNumber)

With .irDriveRegs
.bFeaturesReg = 0
.bSectorCountReg = 1
.bSectorNumberReg = 1
.bCylLowReg = 0
.bCylHighReg = 0
.bDriveHeadReg = &HA0 '
If Not IsWinNT4Plus Then
.bDriveHeadReg = .bDriveHeadReg Or ((drvNumber And 1) * 16)
End If
.bCommandReg = CByte(IDCmd)
End With
End With

If DeviceIoControl(hDrive, _
DFP_RECEIVE_DRIVE_DATA, _
SCIP, _
Len(SCIP) - 4, _
bArrOut(0), _
OUTPUT_DATA_SIZE, _
cbBytesReturned, _
ByVal 0&) Then

CopyMemory IDSEC, bArrOut(16), Len(IDSEC)

di.Model = StrConv(SwapBytes(IDSEC.sModelNumber), vbUnicode)
di.SerialNumber = StrConv(SwapBytes(IDSEC.sSerialNumber), vbUnicode)

IdentifyDrive = True

End If

End Function


Public Function IsWinNT4Plus() As Boolean

Dim osv As OSVERSIONINFO

osv.OSVSize = Len(osv)

If GetVersionEx(osv) = 1 Then

IsWinNT4Plus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And _
(osv.dwVerMajor >= 4)

End If

End Function


Public Function SmartCheckEnabled(ByVal hDrive As Long, _
drvNumber As IDE_DRIVE_NUMBER) As Boolean

Dim SCIP As SENDCMDINPARAMS
Dim SCOP As SENDCMDOUTPARAMS
Dim cbBytesReturned As Long

With SCIP

.cBufferSize = 0

With .irDriveRegs
.bFeaturesReg = SMART_ENABLE_SMART_OPERATIONS
.bSectorCountReg = 1
.bSectorNumberReg = 1
.bCylLowReg = SMART_CYL_LOW
.bCylHighReg = SMART_CYL_HI

.bDriveHeadReg = &HA0
If Not IsWinNT4Plus Then
.bDriveHeadReg = .bDriveHeadReg Or ((drvNumber And 1) * 16)
End If
.bCommandReg = IDE_EXECUTE_SMART_FUNCTION

End With

.bDriveNumber = drvNumber

End With

SmartCheckEnabled = DeviceIoControl(hDrive, _
DFP_SEND_DRIVE_COMMAND, _
SCIP, _
Len(SCIP) - 4, _
SCOP, _
Len(SCOP) - 4, _
cbBytesReturned, _
ByVal 0&)
End Function


Public Function SmartGetVersion(ByVal hDrive As Long) As Boolean

Dim cbBytesReturned As Long
Dim GVOP As GETVERSIONOUTPARAMS

SmartGetVersion = DeviceIoControl(hDrive, _
DFP_GET_VERSION, _
ByVal 0&, 0, _
GVOP, _
Len(GVOP), _
cbBytesReturned, _
ByVal 0&)

End Function


Public Function SmartOpen(drvNumber As IDE_DRIVE_NUMBER) As Long


If IsWinNT4Plus() Then

SmartOpen = CreateFile("\\.\PhysicalDrive" & CStr(drvNumber), _
GENERIC_READ Or GENERIC_WRITE, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, _
OPEN_EXISTING, _
0&, _
0&)

Else

SmartOpen = CreateFile("\\.\SMARTVSD", _
0&, 0&, _
ByVal 0&, _
CREATE_NEW, _
0&, _
0&)
End If

End Function


Public Function SwapBytes(b() As Byte) As Byte()


Dim bTemp As Byte
Dim cnt As Long

For cnt = LBound(b) To UBound(b) Step 2
bTemp = b(cnt)
b(cnt) = b(cnt + 1)
b(cnt + 1) = bTemp
Next cnt

SwapBytes = b()

End Function





Yorumlar, eklemeler ve düşünceler
        Saolasın Güzel Paylasım

   NewCoder, 04.10.2009 18:02
   ellerine sağlık kardeşim güzel bir bilgi kodlarla setup ;)

   POYRAZ, 27.11.2009 23:45
   Vb ' de işe yarayacak işlemlerden bir tanesidir.
Emeğine Sağlık

   Meto, 18.12.2009 12:19
© Hakan Ersöz 2000-2013| Üyelik Sözleşmesi | | Ödeme Bildirimi
Sitemizden yenilikleri hemen öğrenin, pop upları engelleyin, chat yapın... ToolBarımızı indirin:
Vasicmaster Toolbar'ı indirin