Forma media playeri çagirma ( Media PLAyer GeL Lean buraya euhaeha Private Sub Command11_Click Call Shell("C:\Program Files\Windows Media Player\wmplayer. exe /prefetch:1. exe", 1) End Sub

oooooooo bir sürü kodlar var burda paylaşım için sağol O::O

abi helal olsun harika bir palaşım

Bilgisayar her açildiginda program çalissin mi çalismasin mi? Forma bi tane checkbox, bi tane label, bitane textbox, bitane de data nesnesi koyun. bi tane veritabanı oluşturun adınıda sabit. mdb yapın. bu veritabanında bi tane tablo oluşturun adını tbl_kontrol yapın. Bu tabloda bi tane alan oluşturun adını da windows_acilis yapın. text1 nesnesi data1'e bağlayın. label'in captionuna "Bilgisayar her açıldığında program çalışsın" yazın. Bu veritabanı programınızla aynı klasörde olsun. '''''''''''''''''''''''''''''BİTTİ'''''''''''''''''''''''''''''''''''''''''''''' Private Sub Check1_Click If Check1. Value = 0 Then Text1. Text = "1" End If If Check1. Value = 1 Then Text1. Text = "2" End If Dim KayitDefteri As Object Set KayitDefteri = CreateObject If Text1. Text = "1" Then KayitDefteri. RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & App. EXEName, "" & "" & "" & "" End If If Text1. Text = "2" Then KayitDefteri. RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & App. EXEName, App. Path & "\" & App. EXEName & ". exe" End If End Sub Private Sub Form_Activate If Text1. Text = "1" Then Check1. Value = 0 End If If Text1. Text = "2" Then Check1. Value = 1 End If End Sub Private Sub Form_Load Data1. DatabaseName = App. Path & "\sabit. mdb" Data1. RecordSource = "tbl_kontrol" Text1. DataField = "windows_acilis" End Sub

Internetteki access veritabanindaki kayit sayisi Project/Components'ten Microsoft Internet Transfer Control Microsoft Ado Data Control Microsoft Datagrid Control projenize eklyin 1 adet label ve 1 adet command ekleyin kodlari oldugu gibi forma yapistirin Private Sub Command1_Click Label1. Caption = "Veritabaninda toplam " & Adodc1. Recordset. RecordCount & " kayit var" End Sub Private Sub Form_Load Adodc1. ConnectionString = "Provider=Microsoft. Jet. OLEDB.4.0; Data Source=\\www.sezginweb.com\deneme\kayit. mdb" Adodc1. RecordSource = "tblogrenciler" Set DataGrid1. DataSource = Adodc1 End Sub

Ethernet kartinin mac adresini alma Private Const NCBASTAT As Long = &H33 Private Const NCBNAMSZ As Long = 16 Private Const HEAP_ZERO_MEMORY As Long = &H8 Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4 Private Const NCBRESET As Long = &H32 Private Type NET_CONTROL_BLOCK ncb_command As Byte ncb_retcode As Byte ncb_lsn As Byte ncb_num As Byte ncb_buffer As Long ncb_length As Integer ncb_callname As String NCBNAMSZ ncb_name As String NCBNAMSZ ncb_rto As Byte ncb_sto As Byte ncb_post As Long ncb_lana_num As Byte ncb_cmd_cplt As Byte ncb_reserve(9) As Byte ncb_event As Long End Type Private Type ADAPTER_STATUS adapter_address(5) As Byte rev_major As Byte reserved0 As Byte adapter_type As Byte rev_minor As Byte duration As Integer frmr_recv As Integer frmr_xmit As Integer iframe_recv_err As Integer xmit_aborts As Integer xmit_success As Long recv_success As Long iframe_xmit_err As Integer recv_buff_unavail As Integer t1_timeouts As Integer ti_timeouts As Integer Reserved1 As Long free_ncbs As Integer max_cfg_ncbs As Integer max_ncbs As Integer xmit_buf_unavail As Integer max_dgram_size As Integer pending_sess As Integer max_cfg_sess As Integer max_sess As Integer max_sess_pkt_size As Integer name_count As Integer End Type Private Type NAME_BUFFER name As String NCBNAMSZ name_num As Integer name_flags As Integer End Type Private Type ASTAT adapt As ADAPTER_STATUS NameBuff(30) As NAME_BUFFER End Type Private Declare Function Netbios Lib "netapi32. dll" As Byte Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" Private Declare Function GetProcessHeap Lib "kernel32" As Long Private Declare Function HeapAlloc Lib "kernel32" As Long Private Declare Function HeapFree Lib "kernel32" As Long Function GetMACAddress As String Dim tmp As String Dim pASTAT As Long Dim NCB As NET_CONTROL_BLOCK Dim AST As ASTAT NCB. ncb_command = NCBRESET Call Netbios NCB. ncb_callname = " " NCB. ncb_command = NCBASTAT NCB. ncb_lana_num = 0 NCB. ncb_length = Len pASTAT = HeapAlloc(GetProcessHeap , HEAP_GENERATE_EXCEPTIONS Or HEAP_ZERO_MEMORY, NCB. ncb_length) If pASTAT = 0 Then Debug. Print "memory allocation failed!" Exit Function End If NCB. ncb_buffer = pASTAT Call Netbios CopyMemory AST, NCB. ncb_buffer, Len tmp = Format$(Hex(AST. adapt. adapter_address(0)), "00") & " " & Format$(Hex(AST. adapt. adapter_address(1)), "00") & " " & Format$(Hex(AST. adapt. adapter_address(2)), "00") & " " & Format$(Hex(AST. adapt. adapter_address(3)), "00") & " " & Format$(Hex(AST. adapt. adapter_address(4)), "00") & " " & Format$(Hex(AST. adapt. adapter_address(5)), "00") HeapFree GetProcessHeap , 0, pASTAT GetMACAddress = tmp End Function Private Sub Form_Load MsgBox "Ethernet kartının MAC adresi: " + GetMACAddress End Sub

arkadaşLar internete ara vermiştim geri geLdim kodLara tam gaz devam

arkadaslar formun üstüne bi tane command buton eklleyin iki kere tıkLatın ve açın. AÇILAN YERE aşağıdaki kodu ekleyin shell"explorer http://www.wardom.org/forum" programı çalıştırın ve butona tıkLadığınızda Wardom AçıLacaktır... wardom. blackspy@hotmail.com

Vb üzerinden excelde arama yapmak Project/References menülerinden "Microsoft Excel 10.0 Object Library" ekleyin, Formunuza 9 adet text kutusu, 9 adet label ve bir adet command butonu ekleyin, ve aşağıdaki kodları olduğu gibi forma yapıştırın ve çalıştırın. Dim c As Excel. Range Dim xlApp As Excel. Application Dim xlBook As Excel. Workbook Dim xlSheet As Excel. Worksheet Sub ExcelAra On Error GoTo hata Set xlApp = New Excel. Application Text2. Text = "" Set xlBook = Workbooks. Open Set xlSheet = xlBook. Worksheets("sheet 1") With xlSheet. Range("a1:c65536") Set c = . Find(Trim(Text1. Text), lookin:=xlValues) If Not c Is Nothing Then firstAddress = c. Address Text2. Text = c. Address Range(Text2. Text). Select Text3. Text = Excel. ActiveCell. Row '? Kurum Adı Range("$d$" & Text3. Text). Select Text4. Text = Excel. ActiveCell '? Kurum İli Range("$a$" & Text3. Text). Select Text5. Text = Excel. ActiveCell '? Kurum İlçesi Range("$b$" & Text3. Text). Select Text6. Text = Excel. ActiveCell '? Kurum Telefonu Range("$e$" & Text3. Text). Select Text7. Text = Excel. ActiveCell MaskEdBox1. Text = Excel. ActiveCell '? Kurum Fax Range("$f$" & Text3. Text). Select Text8. Text = Excel. ActiveCell '? Kurum Adres Range("$g$" & Text3. Text). Select Text9. Text = Excel. ActiveCell Do c. Interior. Pattern = xlPatternGray50 Set c = . FindNext Loop While Not c Is Nothing And c. Address <> firstAddress End If End With If Text2. Text = "" Then Text2. Text = "Bulunamadı..." xlBook. Close False xlApp. Quit Exit Sub hata: MsgBox Err. Description End Sub Private Sub Command1_Click ExcelAra End Sub

Bilgisayarin sesini açip kisabilirsiniz 1- Forma 1 tane modül, 6 tane label, 2 tane timer, 1 tane check kutusu, 2 tane slider kontrolü ekleyin. ''''''''''''''''''''''''''''Modüle eklenecek kisim'''''''''''''''''''''''''''' Public Declare Function waveOutGetVolume Lib "winmm. dll" As Long Public Declare Function waveOutSetVolume Lib "winmm. dll" As Long Public Const MAXPNAMELEN = 32 ' max product name length Public Type WAVEOUTCAPS wMid As Integer wPid As Integer vDriverVersion As Long szPname As String MAXPNAMELEN dwFormats As Long wChannels As Integer dwSupport As Long End Type Public Declare Function waveOutGetNumDevs Lib "winmm. dll" As Long Public Declare Function waveOutGetDevCaps Lib "winmm. dll" Alias "waveOutGetDevCapsA" As Long ''''''''''''''''''''''''''''''''''Forma eklenecek kisim''''''''''''''''''''''''''''''''''''''' Private Sub Check1_Click Timer1. Interval = 0 Timer2. Interval = 0 End Sub Private Sub Form_Load label1. caption="sag" label2. caption="sol" label3. caption="alçak" label4. caption="yüksek" label5. caption="alçak" label6. caption="yüksek" check1. caption="Kaydirma Göstergeleri Ayni Anda Hareket Etsin" Dim lpc As WAVEOUTCAPS If waveOutGetNumDevs = 0 Then MsgBox End If Call waveOutGetDevCaps(0, lpc, Len If lpc. wChannels = 0 Then Slider2. Visible = False 'mono ise birini gizle End If If (lpc. dwSupport And 4) = 0 Then 'ses ayarini desteklemiyorsa ikisinide gizle Slider1. Visible = False Slider2. Visible = False End If If (lpc. dwSupport And 8) = 0 Then 'sol sag ses ayarini desteklemiyorsa birini gizle Slider2. Visible = False End If Slider1. Min = 0 Slider1. Max = &HFFFF& Slider1. TickFrequency = &HFFFF& / 10 Slider2. Min = 0 Slider2. Max = &HFFFF& Slider2. TickFrequency = &HFFFF& / 10 Dim x, sol, sag, st 'su anki seviyeyi göster Call waveOutGetVolume(0, x) sol = x And &HFFFF& 'düsük seviyeli 2byte st = Hex(x And &HFFFF0000) If Len > 4 Then st = Mid(st, 1, Len - 4) 'yüksek seviyeli 2 bayti al Else st = 0 End If sag = CDbl Slider1. Value = sol Slider2. Value = sag End Sub Sub sesayar Dim x, sol, sag, s sol = Slider1. Value sag = Slider2. Value s = Val("&h" & Hex & String(4 - Len(Hex , "0") & Hex & "&") Call waveOutSetVolume(0, s) End Sub Private Sub Slider1_Click sesayar End Sub Private Sub Slider1_Scroll If Check1. Value = 0 Then Else Timer1. Interval = 0 Timer2. Interval = 1 End If sesayar End Sub Private Sub Slider2_Click sesayar End Sub Private Sub Slider2_Scroll If Check1. Value = 0 Then Else Timer2. Interval = 0 Timer1. Interval = 1 End If sesayar End Sub Private Sub Timer1_Timer Slider1 = Slider2 End Sub Private Sub Timer2_Timer Slider2 = Slider1 End Sub

List kutusunu access veritabanina baglamak forma bi tane data nesnesi bi tane de list kutusu ekleyin. Private Sub Form_Activate Data1. Recordset. MoveFirst Do Until Data1. Recordset. EOF List1. AddItem (Data1. Recordset! ) Data1. Recordset. MoveNext Loop End Sub Private Sub Form_Load Data1. DatabaseName = App. Path & "\sabit. mdb" Data1. RecordSource = "tbl_stok" End Sub