ben daha vbasici halledemedim kaldı delphi :D ama sz en yakın zamanda sana kodları buluıcam :P

ati sana küstüm ben delphi olanını neden vermedin küstüm bir daha konuşma benle :D DAĞDA ÜÇ BEŞ KOYUN SÜRÜSÜ, TUTTURMUŞ BİR KÜRDİSTAN TÜRKÜSÜ, ELİNE ALMIŞ BAYRAK DİYE BİR MASA RTÜSÜ, SATSAN BEŞ PARA ETMEZ NE DİRİSİ NE DE LÜSÜ, SOYU SOYSUZ OLAN SENSİN TOPRAK SENİN NEYİNE, İTE İTLİK YAPIP KAFA TUTMA BEYİNE, ANLASA DEDİĞİMİ SOKAKTAKİ KPEK AĞLAR HALİNE, DUY ULAN SOYSUZ NE MUTLU TÜRKÜM DİYENE...

Güzel kodlar bi de kullanmayı bilsek |Tandır Tava Gedli Hamur Tükendi| Akıl Başa Geldi mür Tükendi |

Option ExplicitPrivate Declare Function ReleaseCapture Lib "user32" As LongPrivate Declare Function SendMessage Lib "user32"Alias _"SendMessageA" As LongPrivate Const HTCAPTION = 2Private Const WM_NCLBUTTONDOWN = &HA1Private Const WM_SYSCOMMAND = &H112Private Sub label1_MouseDown Call ReleaseCaptureSendMessage Me. hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&End SubPrivate Sub Command1_Click Unload MeEnd Sub INTERNET BAGLANTI BILGILERINI GRENMEKInternet üzerinden alinan ve gnderilen byte miktarlari Registry icine kaydedilir. Yanliz Bu kod Windows NT altinda calismiyor. Ek olarak transfer hizini ve baglanti hizini da grenebiliyoruz. Option ExplicitPrivate Declare Function RegOpenKeyEx Lib "advapi32. dll"Alias _"RegOpenKeyExA" As LongPrivate Declare Function RegCloseKey Lib "advapi32. dll" As LongPrivate Declare Function RegQueryValueEx Lib "advapi32. dll"Alias _"RegQueryValueExA" As LongConst HKEY_DYN_DATA = &H80000006Const KEY_READ = &H19Const ERROR_SUCCESS = 0&Dim s1&, e1&, LBytes&, CNT&, Q&, QQ&, SUM&Private Sub Command1_Click ResetEnd SubPrivate Sub Form_Load ResetLBytes = e1Timer1. Enabled = TrueTimer1. Interval = 100End SubPrivate Sub Timer1_Timer Dim EBytes&, SBytes&, CSpeed&EBytes = ReadBytes SBytes = ReadBytes CSpeed = ReadBytes If EBytes > -1 Then Label1. Caption = EBytes - e1If SBytes > -1 Then Label2. Caption = SBytes - s1If SBytes > -1 And EBytes <> e1 ThenLabel5. Caption = CSpeedEnd IfIf LBytes < EBytes ThenQ = / (Timer1. Interval / 1000)CNT = CNT + 1ElseQ = 0End IfSUM = SUM + QQQ = SUM / CNTLabel6. Caption = " " & QLBytes = EBytesEnd SubPrivate Function ReadBytes As LongDim hKey&, L&, X&, DW&X = RegOpenKeyEx(HKEY_DYN_DATA, "PerfStats\StatData", 0, _KEY_READ, hKey)If X <> ERROR_SUCCESS Then Exit FunctionX = RegQueryValueEx(hKey, Entry, 0&, DW, ByVal 0&, L)If X <> ERROR_SUCCESS Then Exit FunctionX = RegQueryValueEx(hKey, Entry, 0&, DW, ReadBytes, L)If X <> ERROR_SUCCESS Then Exit FunctionRegCloseKey hKeyEnd FunctionPrivate Sub Reset e1 = ReadBytes s1 = ReadBytes SUM = 0CNT = 1End Sub INTERNET BAGLANTI DURUMUNU OGRENMEKBu kod sayesinde internete bagli olup olmadigimiz grenilebilir Option ExplicitPrivate Declare Function RasEnumConnections Lib "RasApi32. dll" _Alias "RasEnumConnectionsA" As LongPrivate Declare Function RasGetConnectStatus Lib "RasApi32. dll" _Alias "RasGetConnectStatusA" As LongConst RAS_MaxEntryName = 256Const RAS_MaxDeviceType = 16Const RAS_MaxDeviceName = 32Private Type RASTypedwSize As LonghRasCon As LongszEntryName As ByteszDeviceType As ByteszDeviceName As ByteEnd TypePrivate Type RASStatusTypedwSize As LongRasConnState As LongdwError As LongszDeviceType As ByteszDeviceName As ByteEnd TypePrivate Sub Form_Load Timer1. Interval = 200Timer1. Enabled = TrueEnd SubPrivate Sub Timer1_Timer DFÜStatusEnd SubPrivate Function DFÜStatus As BooleanDim RAS(255) As RASType, RASStatus As RASStatusTypeDim lg&, lpcon&, Result&RAS(0). dwSize = 412lg = 256 RAS(0). dwSizeResult = RasEnumConnections(RAS(0), lg, lpcon)If lpcon = 0 ThenLabel1. Caption = "Offline" 'DFÜStatus = FalseElseRASStatus. dwSize = 160Result = RasGetConnectStatus(RAS(0). hRasCon, RASStatus)If RASStatus. RasConnState = &H2000 ThenLabel1. Caption = "Online" 'DFÜStatus = TrueElseLabel1. Caption = "Baglanti Kopuk" 'DFÜStatus = FalseEnd IfEnd IfEnd Function INTERNET BAGLANTISI OLUSTURMAK - KESMEKBu kod sayesinde internete bagli olup olmadigimiz grenilebilir. Option ExplicitConst RAS_MaxDeviceType = 16Const RAS95_MaxDeviceName = 128Const RAS95_MaxEntryName = 256Private Type RASENTRYNAME95dwSize As LongszEntryName(RAS95_MaxEntryName) As ByteEnd TypePrivate Type RASCONN95dwSize As LonghRasConn As LongszEntryName(RAS95_MaxEntryName) As ByteszDeviceType As ByteszDeviceName(RAS95_MaxDeviceName) As ByteEnd TypePrivate Declare Function RasEnumConnections Lib "RasApi32. DLL" _Alias "RasEnumConnectionsA" As LongPrivate Declare Function RasEnumEntries Lib "RasApi32. DLL" _Alias "RasEnumEntriesA" As LongPrivate Declare Function RasHangUp Lib "RasApi32. DLL" _Alias "RasHangUpA" As LongDim DFÜname$, RCon As LongPrivate Sub HangUp Dim s As Long, l As Long, ln As Long, aa$ReDim r(255) As RASCONN95r(0). dwSize = 412s = 256 r(0). dwSizel = RasEnumConnections(r(0), s, ln)For l = 0 To ln - 1aa = StrConv(r . szEntryName , vbUnicode)aa = Left$(aa, InStr(aa, Chr$(0)) - 1)If aa = Verbindung ThenRCon = r . hRasConnDim rec As Longrec = RasHangUp End IfNext lEnd SubPrivate Sub Command1_Click If List1. ListIndex = -1 Then Exit SubDFÜname = List1. List(List1. ListIndex)Shell "rundll32. exe rnaui. dll, RnaDial " & DFÜnameSendKeys " ", TrueSendKeys " ", TrueMe. SetFocusEnd SubPrivate Sub Command2_Click Call HangUp End SubPrivate Sub Form_Load Dim s As Long, ln As Long, i%, conname$Dim r(255) As RASENTRYNAME95r(0). dwSize = 264s = 256 r(0). dwSizeCall RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)For i = 0 To ln - 1conname = StrConv(r . szEntryName , vbUnicode)List1. AddItem Left$(conname, InStr - 1)Next iIf List1. ListCount <> 0 Then List1. ListIndex = 0End Sub Formu Yakip SndürmePrivate Sub Timer1_Timer If Me. Visible = True ThenMe. Visible = FalseElseMe. Visible = TrueEnd IfEnd SubPrivate Sub Command1_Click Timer1. Interval = 1000End SubFormu KaydirmaPrivate Sub Command1_Click Do Until Form1. Top = Screen. HeightForm1. Top = Form1. Top + 1LoopUnload MeEnd SubEkran KoruyucuPublic Sub drawcircle Dim red As Integer 'declare all variblesDim blue As IntegerDim green As IntegerDim xPos As IntegerDim yPos As Integerred = 255 Rnd 'randomize red colorblue = 255 Rnd 'randomize blue colorgreen = 255 Rnd 'randomize green colorxPos = ScaleWidth / 2yPos = ScaleHeight / 2radius = ((yPos 0.99) + 1) RndCircle , radius, RGB End SubPrivate Sub Timer1_Timer Call drawcircleEnd SubTitreyen FormPrivate Sub Form_Load Timer1. Interval = 22End SubPrivate Sub Timer1_Timer Form1. Top = Form1. Top + 50Form1. Top = Form1. Top - 50Form1. Left = Form1. Left - 50Form1. Left = Form1. Top + 50End SubFormu YuvarlatmaPrivate Sub Form_Load Dim hr&, dl&Dim usew&, useh&usew& = Me. Width / Screen. TwipsPerPixelXuseh& = Me. Height / Screen. TwipsPerPixelYhr& = CreateEllipticRgn(55, -20, usew, useh)dl& = SetWindowRgn End SubHer Koseden Program KapatmaPrivate Sub Cmd1çıkış_Click Do Until Form1. Height = 405 And Form1. Width = 1680Form1. Height = Form1. Height - 1Form1. Width = Form1. Width - 1LoopUnload MeEnd SubPrivate Sub Form_Load Form1. Caption = "Form Move"Form1. Height = 0Form1. Width = 1680Timer1. Interval = 200Timer1. Enabled = TrueEnd SubPrivate Sub Timer1_Timer On Error Resume NextFor x = 0 To Form1. Height + 2000Form1. Height = xNext xFor y = 100 To Form1. Width + 1500Form1. Width = yNext yTimer1. Enabled = FalseEnd SubYanip Sonen LabelPrivate Sub Command1_Click For X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbRedFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbBlueFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbGreenFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbRedEnd SubPrivate Sub Form_MouseMove For X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbRedFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbBlueFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbGreenFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbRedEnd SubPrivate Sub label1_MouseMove For X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbRedFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbBlueFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbGreenFor X = 1 To 5000: DoEvents: Next Xlabel1. ForeColor = vbRedEtrafa Carpan TopPrivate Sub Command1_Click EndEnd SubPrivate Sub topa_Click End SubPrivate Sub xgeri_Timer topa. Left = topa. Left - 100If topa. Left < 0 Thenxileri. Enabled = Truexgeri. Enabled = FalseEnd IfEnd SubPrivate Sub xileri_Timer topa. Left = topa. Left + 100If topa. Left > 13000 Thenxileri. Enabled = Falsexgeri. Enabled = TrueEnd IfEnd SubPrivate Sub ygeri_Timer topa. top = topa. top - 100If topa. top < 0 Thenyileri. Enabled = Trueygeri. Enabled = FalseEnd IfEnd SubPrivate Sub yileri_Timer topa. top = topa. top + 100If topa. top > 9000 Thenyileri. Enabled = Falseygeri. Enabled = TrueEnd IfEnd SubCtrl-Alt-Delete ve Ctrl-Esc tus kombinasyonlarinin calismasini iptal etme!!!! Private Declare Function SystemParametersInfo Lib _"user32" Alias "SystemParametersInfoA" As LongSub CtrlAltDeleteKapat Dim X As LongX = SystemParametersInfo(97, Kapali, CStr(1), 0)End SubCtrl-Alt-Delete kombinasyonunu kapatmak için:Call CtrlAltDeleteKapat Ctrl-Alt-Delete kombinasyonunu açmak için:Call CtrlAltDeleteKapat --alıntıdır