Rabu, 23 November 2011

MEMBUAT INFORMASI OEM SENDIRI

Yah sambil iseng coba-coba saya mau mengganti tampilan OEM, daripada tampilannya biasa - biasa saja lebih baik dirubah selain biar tampil beda sekalian buat menunjukkan kalo PC ini punya saya sebab di OEM ada poto sayanya.kayak screenshoot di bawah ini:
nih tampilan OEM-nya
ini tampilan screeshoot program sederhananya:
OEM Owner Maker

Jadi sobat blogger bisa menggantinya sendiri.Ini saya share sourde codenya, VB 6 ya...!
=======================================================================
Private Sub Command1_Click()
If Text1.Text = "" And Text2.Text = "" And Text3.Text = "" And Text4.Text = "" And Text5.Text = "" And Text6.Text = "" Then
Exit Sub
Else
manu
model
hour
url
phone
logo
cek = AmbilString(HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "Manufacturer")
If cek = "" Then
manu
Else
If MsgBox("data tidak kosong apakah anda ingin menngantinya..?", vbQuestion + vbOKCancel, "oye") = vbOK Then
manu
End If
cek = AmbilString(HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "Model")
If cek = "" Then
model
Else
model
End If
cek = AmbilString(HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportHours")
If cek = "" Then
hour
Else
hour
End If
cek = AmbilString(HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportURL")
If cek = "" Then
url
Else
url
End If
cek = AmbilString(HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportPhone")
If cek = "" Then
phone
Else
phone
End If
cek = AmbilString(HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "Logo")
If cek = "" Then
logo
Else
logo
End If
End If
MsgBox "Informasi OEM telah di buat silahkan tekan tombol" & vbCrLf & "win + Pause Break", vbInformation, "powered by dendrif deo"
End If
End Sub

Private Sub Command2_Click()
t = BrowseForFolder(, "Silahkan pilih file bmp,jpg,atau jpeg", , , Text6.Text, True, True)
    If t <> "" Then
        Text6.Text = t
    End If
End Sub
Private Sub manu()
If Text1.Text = "" Then
Exit Sub
Else
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "Manufacturer", Text1.Text
End If
End Sub
Private Sub model()
If Text2.Text = "" Then
Exit Sub
Else
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "Model", Text2.Text
End If
End Sub
Private Sub hour()
If Text3.Text = "" Then
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportHours", "1 x 24 jam"
Else
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportHours", Text3.Text & " jam"
End If
End Sub
Private Sub url()
If Text4.Text = "" Then
Exit Sub
Else
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportURL", Text4.Text
End If
End Sub
Private Sub phone()
If Text5.Text = "" Then
Exit Sub
Else
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "SupportPhone", Text5.Text
End If
End Sub
Private Sub logo()
If Text6.Text = "" Then
Exit Sub
Else
BuatString HKLM, "SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation", "Logo", Text6.Text
End If
End Sub
Private Sub Command3_Click()
Open "C:\windows\meo.reg" For Output As 2
Print #2, "Windows Registry Editor Version 5.00"
Print #2, ""
Print #2, "[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation]"
Close #2
Shell ("regedit /s C:\windows\meo.reg")
Kill "C:\windows\meo.reg"
Open "C:\windows\me.reg" For Output As 1
Print #1, "Windows Registry Editor Version 5.00"
Print #1, ""
Print #1, "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\OEMInformation]"
Close #1
Shell ("regedit /s C:\windows\me.reg")
Kill "C:\windows\me.reg"
MsgBox "Informasi OEM telah di hapus", vbInformation, "powered by dendrif deo"
End Sub

Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
If App.PrevInstance Then
End
End If
End Sub

Private Sub Timer1_Timer()
Dim dendrifcaption As String
Dim c As Integer
Dim scrollrighttoleft As String
Dim dendriflastchar As String
dendrifcaption = Me.Caption
If dendrifcaption = "" Then
Exit Sub
End If
For c = 0 To Len(dendrifcaption)

'dendriflastchar = Right(dendrifcaption, 1)
'Me.Caption = dendriflastchar & Left(dendrifcaption, Len(dendrifcaption) - 1)

dendriflastchar = Left(dendrifcaption, 1)
Me.Caption = Mid(dendrifcaption, 2) & dendriflastchar

Next c
End Sub
====================================================================

sorce code ini kurang rapi silahkan sobat blogger sempurnakan.
program sederhana ini bisa didownload disini 
dan ini versi berikutnya perbaikan BUG disini
Password = www.dendrif-deo.co.cc[OEM]

semoga bermanfaat.....  :D

Tidak ada komentar:

Posting Komentar