MAKALELER, HAZIR KODLAR

[OG]

API FONKSİYONLARI

" windowsu yeniden başlatan,cd room açan kapatan kodlar... kısaca bilgisayarınızı kodlarla yönetin "

Windows işletim sisteminin bazı fonksiyonlarının Visual Basic uygulaması içerisinde kullanılması istendiğinde API fonksiyonlarından yararlanılır. Böylece kullanıcı işletim sistemi ile karşı karşıya gelmeden sistemin bazı fonksiyonlarını VB uygulaması içerisinden yapabilmektedir. API (Application Programming Interface)'ler Windows'un dahili fonksiyonlarıdır.

API fonksiyonları hakkında bilgi almak için API Text Viewer kullanılır.
Başlat – Programlar – MS Visual Studio 6.0 – MS Visual Studio 6.0 Tools - API Text Viewer kullanılır.

veya

VB de Add-Ins menüsünden Add-In Manager kullanılabilir. VB 6 API Viewer seçilir ve Load Behaviors çerçevesinden Loaded/Unloaded ve Load On StartUp işaretlenirse VB her açıldığında Add-Ins menüsünden de erişilebilir.

API Viewer da File – Load Text File dan Win32api.txt dosyası seçilir.

Windows'u yeniden başlatma ve kapama
1- API Viewer dan ExitWindowsEx fonksiyonu seçilir.
2- Form tasarlanır.
3- Projeye bir modül eklenir.
4- Kullanacağımız ExitWindowsEx API fonksiyonunu tanımlamak amacıyla Declare satırı modüle yapıştırılır:

Option Explicit

Public Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long

5- Private Sub Command1_Click()
Dim sonuc As Long
sonuc = ExitWindowsEx(2, 0)
End Sub

Private Sub Command2_Click()
Dim sonuc As Long
sonuc = ExitWindowsEx(1, 0)
End Sub
CD-ROM sürücüyü açıp-kapatan program
1- API Viewer dan mciExecute fonksiyonu seçilir.
2- Form tasarlanır


3- Projeye bir modül eklenir.
4- Kullanacağımız mciExecute API fonksiyonunu tanımlamak amacıyla Declare satırı modüle yapıştırılır:

Public Declare Function mciExecute Lib "winmm.dll" _
(ByVal lpstrCommand As String) As Long

5- Program kodu yazılır:

Private Sub Command1_Click()
Dim sonuc As Long
sonuc = mciExecute("Set CDAudio door Open")
End Sub

Private Sub Command2_Click()
Dim sonuc As Long
sonuc = mciExecute("Set CDAudio door closed")
End Sub


Dosya kopyalama
1- API Viewer dan CopyFile fonksiyonu seçilir.
2- Form tasarlanır
3- Projeye bir modül eklenir.
4- Kullanacağımız CopyFile ve DeleteFile API fonksiyonunu tanımlamak amacıyla Declare satırı modüle yapıştırılır:

Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" _
(ByVal lpFileName As String) As Long

5- Program kodu yazılır:

Private Sub Command1_Click()
Dim sonuc As Long, kaynakdosya As String, hedefdosya As String
kaynakdosya = InputBox("Kopyalanacak dosyanın adını ve yolunu giriniz")
hedefdosya = InputBox("Yeni dosyanın adını ve kopyalanacağı yeri giriniz")
sonuc = CopyFile(kaynakdosya, hedefdosya, 0)
End Sub

Private Sub Command2_Click()
Dim sonuc As Long, silinecekdosya As String
silinecekdosya = InputBox("Silinecek dosyanın adını ve yolunu giriniz")
sonuc = DeleteFile(silinecekdosya)
End Sub

[OG]

Listbox ın fare ile kontrolü

" Listbox elemanlarının liste içinde fare ile taşınması (yer değiştirme) "

Dim ilkOge As String
'tasinacak ogeyi tanimliyoruz
Dim ikinciOge As String
'birinci oge ile yer degisecek ikinci ogeyi tanimliyoruz...
Dim ogeNo As Integer ' listindex i tutacagimiz degisken

Private Sub Form_Load()
'birkac oge ekliyoruz
List1.AddItem "1-Ahmet"
List1.AddItem "2-Ayşe"
List1.AddItem "3-Naciye"
List1.AddItem "4-Pakize"
List1.AddItem "5-Cemal"
List1.AddItem "6-Nuri"
End Sub
Public Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then 'farenin sol tusuna basildiysa
ilkOge = List1.Text 'ilk ogemizi sakliyoruz
ogeNo = List1.ListIndex 'index numaramizi aliyoruz
End If
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If ilkOge = List1.Text Then Exit Sub
'eger tikladigimiz ogenin uzerindeysek islem yapmiyoruz
If ilkOge = "" Then Exit Sub
'secili oge yoksa islem yapmiyoruz

ikinciOge = List1.Text
'ikinci ogenin uzerine gelince onu da aliyoruz

List1.List(ogeNo) = ikinciOge
've ikinci ogeyi az önce bilgilerini sakladigimiz
'birinci ogenin yerine gonderiyoruz


ogeNo = List1.ListIndex
'oge numaramiza su an uzerinde bulundugumuz ikinci ogenin
'index numarasini veriyoruz
List1.List(ogeNo) = ilkOge
've ilk ogemizi ikinci ogenin yerine geciriyoruz...
End Sub

[OG]

SQL QUERYSINI HIZLANDIRMAK

SQL SERVERDA SAYET SIZ BIR TARAFTAN SELECT QUERYSI ILE BIR SEYLER ALMAK ISTERKEN DIGER KULLANICILAR ISE AYNI TABLODA DELETE ,INSERT, UPDATE GIBI QUERYLERINI CALISTIRIYORLAR ISE BU DURUMDA SIZIN SELECT QUERINIZ BINDE BIR DE OLSA DEADLOCK DURUMUNA DUSER BUNU ONLEMEK ICIN UFAK BIR YOL VAR ;


SELECT A_KOLUNU FROM TABLO1 (WITHNOLOCK) WHERE ......

BURDA KOYDUGUMUZ WITHNOLOCK O SIRADA DEGISEN KAYITLARI ESKI HALLERI ILE SIZE GETIRECEK BU SEKILDE SIZDE DEADLOCK DURUMUNA DUSMEZSINIZ AYRICA QUERY PERFORMANSINIDA BELLI BIR OLCUDE HIZLANDIRABILIRSINIZ. UMARIM ISINIZE YARAR

[OG]

Visual Basic'te port kontrolu

Open komutu ile seri ve paralel iletisim saglanabilinir.
Bu komutu hatirlayalim;

Open "Dosya Adi" For ErisimModu As #DosyaNo
Örnek olarak: Open sayilar.txt For Output As #1

Buradaki dosya adi yerine seri port "COM1:" veya "COM2:", yada paralel port "LPT1:" veya "LPT2:" kullanilabilinir.

Simdi Open komutu ile LPT2 portunu açalim ve Write# komutu ile bu porta bilgi gönderelim. Gönderdigimiz bilgiler eger LPT2 üzerinde printer varsa çikti alabiliriz.


Kod:
Private Sub Form_Load()
Open "lpt2:" For Output As #1
Write #1, "Bu satirlar yazicidan cikicak"
Write #1, "Bu kod ile printer kablolarinizda bir sorun olup olmadigini"
Write #1, "kontrol edebilirsiniz"
Close #1
End Sub


Eger printerimiz LPT2 portuna bagliysa bu bilgiler yazicidan çikicaktir.Bu kod ile printerimizin fiziksel ayalarinda bir sorun olup olmadigini da denetlemis oluyoruz.

Bir baska örnekte bugünlerde çok moda olan dialer programlarinin benzeri birsey yaratabiliriz
COM2`ye baglanmis bir modem`e 2252442 nolu numarayi çevirmesini söyleyelim. Modeme bir numara çevirmesini söylemek için "ATDT" komutu kullanilir.


Kod:
Private Sub Form_Load()
Open "com2:" For Binary As #1
Put #1, , "ATDT 2252442" & vbCr
Close #1
End Sub


Yazicaginiz degisik kodlar ile firewall ve virüs koruma programlari kolayca atlatilabilinir.

[OG]

Tüm Form Unload Olaylarında Onay Alma

" Programınız ister görev yöneticisinden kapansın ister form içinden kapasın yinede onay almadan kapanmayacaktır... "

Private Sub Form_UnLoad(Cancel As Integer)

Set Form1 = Nothing 'Burada formumuzun kapandıktan sonra bellekte yer edinememesini sağlıyoruz

Dim i As Integer
For i = Forms.Count - 1 To 1 Step -1
Unload Forms(i)
Next
If Me.WindowState <> vbMinimized Then 'Formumuzun son halini belleğe kaydettiriyoruz
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
Dim intmsg As Integer, intbutton As Integer
intmsg = vbYesNo + vbQuestion
intbutton = MsgBox("Devam etmek istiyormusunuz ?", intmsg, "Porgramdan Cikmak Uzeresiniz")
Select Case intbutton
Case vbYes
Cancel = 0 'form kapatilir
Dim n As Long
Unload Me
Case vbNo
Cancel = -1 'form kapatilmaz
End Select
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Select Case UnloadMode
Case vbAppWindows
Dim intmsg1 As Integer, intbutton1 As Integer
intmsg1 = vbYesNo + vbQuestion
intbutton1 = MsgBox("Devam etmek istiyormusunuz ?", intmsg1, "Programdan Cikmak Uzeresiniz")
Select Case intbutton1
Case vbYes
Cancel = 0 'form kapatilir
Unload Me
Case vbNo
Cancel = -1 'form kapatilmaz
End Select

Case vbAppTaskManager 'TaskManager (Görev Yöneticisi) Unload olayı
Dim intmsg2 As Integer, intbutton2 As Integer
intmsg2 = vbYesNo + vbQuestion
intbutton2 = MsgBox("Devam etmek istiyormusunuz ?", intmsg2, "Programdan Cikmak Uzeresiniz")
Select Case intbutton2
Case vbYes
Cancel = 0 'form kapatilir
Unload Me
Case vbNo
Cancel = -1 'form kapatilmaz
End Select

Case vbFormMDIForm 'MDI Form Unload olayı
Dim intmsg3 As Integer, intbutton3 As Integer
intmsg3 = vbYesNo + vbQuestion
intbutton3 = MsgBox("Devam etmek istiyormusunuz ?", intmsg3, "Programdan Cikmak Uzeresiniz")
Select Case intbutton3
Case vbYes
Cancel = 0 'form kapatilir
Unload Me
Case vbNo
Cancel = -1 'form kapatilmaz
End Select
End Select
End Sub

Umarım işinize yarar benim uzun süre işime yaradı sizlerle paylaşmak istedim...
Onay alma işlerleri sırasında form'unuza bazı işlemleri yaptırabilirsiniz mesela...

[OG]

çalışan forma nasıl resim eklenir

image veya pictureboxta aynı işlem yapılıyo şaşırmayın

ben image ile göstereceğim

bu örnek için formunuza commondialog eklemeniz lazım

image1.picture=loadpicture(commondialog1.filename)

[OG]

Visual Basic'te MSFlexGrid ile listelemede maximum hız

Arkadaşlar VisualBasic'le uğraşanlar bilirler ki MSFlexGrid'e yada MSHFlexGrid'e eğer kodla listeleme yaptırıyorsanız ve de listeleyeceğiniz kayıtlşar mesela 10000-100000 kayıt gibi çok fazla ise listeleme işlemi çok uzun sürecek ve dolayısıyla programın kitlenmesine bile sebep olabilecektir. İşte bu durmdan kurtulmak için listeleme yapmadan önce gridin visible özelliğini "False" yapıyoruz. Listeleme bittikten sonrada tekrar visible özelliğni "True" yapıyoruz. Bu sayede belki dakikalarca sürecek listeleme işlemi birkaç saniye içinde gerçekleşiyor. Aşağıda örnek kullanım mevcuttur. Hepinize çalışmalarınızda başarılar....



'ÖRNEK KULLANIM:
'---------------------------------------------------------
On Error Resume Next
MSFlexGrid1.Visible = False
Data1.RecordSource = "Select * from [URUNLER] order by [katalogadi] asc"
Data1.Refresh
For i = 1 To Data1.Recordset.RecordCount
MSFlexGrid1.Row = i
MSFlexGrid1.Col = 0
MSFlexGrid1.Text = Data1.Recordset![UrunKodu]
MSFlexGrid1.Col = 1
MSFlexGrid1.Text = Data1.Recordset![UrunAdi]
MSFlexGrid1.Col = 2
MSFlexGrid1.Text = Data1.Recordset![KatalogAdi]
MSFlexGrid1.Col = 3
MSFlexGrid1.Text = Data1.Recordset![AlFiyati]
MSFlexGrid1.Col = 4
MSFlexGrid1.Text = Data1.Recordset![SatFiyati]
MSFlexGrid1.Col = 5
MSFlexGrid1.Text = Data1.Recordset![FiyatTuru]
MSFlexGrid1.Col = 6
MSFlexGrid1.Text = "% " & Data1.Recordset![KDV]
MSFlexGrid1.Col = 7
MSFlexGrid1.Text = Data1.Recordset![StokSayisi]
MSFlexGrid1.Col = 8
MSFlexGrid1.Text = Data1.Recordset![BirimOlcu]
MSFlexGrid1.Col = 9
MSFlexGrid1.Text = Data1.Recordset![GarSuresi]
MSFlexGrid1.Col = 10
MSFlexGrid1.Text = Data1.Recordset![Aciklama]
Data1.Recordset.MoveNext
next
MSFlexGrid1.Visible = True

[OG]

Formunuz daha aktif olsun

Visual Basic te labellarınız veya pictureboxlarınız yeni olaylara rağmen hiçbir değşikliğe uğramıyormu ? Nasıl yani ? Mesela sürekli caption u değişecek bir labelınız veya resmi sürekli değişecek bir picturebox ınız arada sırada da olsa değişimiyor takılıyor mu ? İşte o zaman formunuzun AutoRedraw özelliğini True yapın ve bu gibi sorunlardan kurtulun....Bu özelliği her zaman True yapmanız önerilir.Özellikle hareketli objeleri kullanıyor veya oyun yapıyorsanız.....

[OG]

Kullandığınız bilgisayarın dış ip numarası, iç ip numarası, bilgisayarınızın adını, kullanıcı adını

Kullandığınız bilgisayarın dış ip numarası, iç ip numarası, bilgisayarınızın adını, kullanıcı adını gösteren ufak bir çalışma
Not:Yazı içindeki bazı kodlar bu site içinden alınmış ve yine sizlere bir çalışma olarak sunulmuştur.Emeği geçenlere teşekkür ederim.

bir form açın
form içine 1 adet frame ekleyin
frame içine 5 adet label, 2 adet buton yerleştirin
1 adet timer, 1 adet inet nesnesi yerleştirdikten sonra aşağıdaki kodu formunuza yerleştirin



Function VeriAl(AnaMetin, OnMetin, ArkaMetin) ' dış İp numarasını öğrenmek için
Dim Baslangic, Bitis, Uzunluk As Long
Baslangic = InStr(1, AnaMetin, OnMetin) + Len(OnMetin)
Bitis = InStr(Baslangic, AnaMetin, ArkaMetin)
Uzunluk = Bitis - Baslangic
VeriAl = Mid(AnaMetin, Baslangic, Uzunluk)
End Function
Public Function NetworkUserName() As String ' network user nameyi bulmak
Dim lpBuff As String * 25
Dim retval As Long
retval = GetUserName(lpBuff, 25)
NetworkUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function

Private Sub Command1_Click()' formunuzu kapatmak için
End
End Sub

' internet bağlantınız kesildiği zaman Dış ip numaranız değişir
' yeni numarayı öğrenmek için tıklayın
Private Sub Command2_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Label1.ForeColor = vbBlue
Label2.ForeColor = vbBlue
Label3.ForeColor = vbBlue
Label4.ForeColor = vbBlue
Label5.ForeColor = vbBlue
Label1.FontBold = True
Label2.FontBold = True
Label3.FontBold = True
Label4.FontBold = True
Label5.FontBold = True
Frame1.Caption = "Dış-İç İp, Kullanıcı Adı,Pc Adı "
Frame1.ForeColor = vbRed
Frame1.FontBold = True
Command1.Caption = "Kapat"
Command2.caption="Yenile"
End Sub
Private Sub Timer1_Timer()
Label1 = "Dış İp No : " + (VeriAl(Inet1.OpenURL("www.whatismyip.com"), "displaycopy(' ", "' )")) ' dış ip numarasını bul
Label2 = "Pc Adı : " + GetIPHostName() ' PC adını bul
Label3 = "İç İp No : " + GetIPAddress() ' iç ip numarası
If Label3 = "İç İp No : " + "127.0.0.1" Then ' internet bağlantısı kesikse ikaz ver
Label5 = "Bağlantı Kesik"
Else
Label5 = "Bağlantı Sağlandı"
End If
Timer1.Enabled = False
Call NetworkUserName
Label4 = "Kullanıcı Adı : " + NetworkUserName
End Sub

[OG]

Listbox ları senkronize etmek

Listbox ları nasıl sekronize ederiz yani üç tane listbox umuz olduğunu düşünün
Müşteri adı , müşteri soyadi , müşteri bilgisi .Şimdi 3 tane listboxu ve bu listboxların ne işe yaradığını anlatan labelleri yaptık
Şimdi bir sorunumuz olacak diyelimki biz 1 .listboxtan müşteri adını seçtiğimizde diğer listboxların o müşteriyle ilgili soyisim ve müşteri bilgilerine ulaşamamızı VB
Nasıl yapacak ? işte burada listboxların iki özelliği topindex ve listindex özelliği orataya çıkıyor.

Şimdi kodumuzu yazalım

Private sub List1_click (index as integer )

Dim i , ind , tind

ind = List1 (index).listindex
tind = List1(index).topindex
For i=0 to 2

List1(i).listindex=ind
List1(i).topindex =tind
Next
End sub

İşte bu kod ile Listboxları istediğiniz gibi sekronize edebilirsiniz. Seçtiğiniz 1. listbox ların 1 kaydı için , 2. listboxların ve 3. listboxların 1. kayıtları karşınıza çıkar.

[OG]

PROGRAMINIZA ONLINE DOVIZ KURUNU GÖMÜN

İlk önce Project/Components Menüsünden İnternet Tarnsfer Control Seçeneğini seçip uygula diyoruz.Daha sonra Form'umuza 1 tane inet ve 34 tane text ekliyoruz. Ve ardındanşu kodları yazıyoruz. (Döviz Kurunu TCMB'nin sitesinden alır)

Private Sub Command1_Click()
Dim strkur
strkur = Inet1.OpenURL("http://www.tcmb.gov.tr/kurlar/today.html") 'TCMB Sitesine bağlanır.
Text1.Text = Mid(strkur, InStr(strkur, "USD") + 41, 7) 'Alış Fiyatını texte yazdırır
Text2.Text = Mid(strkur, InStr(strkur, "USD") + 53, 9) 'Satış Fiyatını texte yazdırır
Text3.Text = Mid(strkur, InStr(strkur, "AUD") + 41, 7)
Text4.Text = Mid(strkur, InStr(strkur, "AUD") + 53, 9)
Text5.Text = Mid(strkur, InStr(strkur, "DKK") + 41, 7)
Text6.Text = Mid(strkur, InStr(strkur, "DKK") + 53, 9)
Text7.Text = Mid(strkur, InStr(strkur, "EUR") + 41, 7)
Text8.Text = Mid(strkur, InStr(strkur, "EUR") + 53, 9)
Text9.Text = Mid(strkur, InStr(strkur, "GBP") + 41, 7)
Text10.Text = Mid(strkur, InStr(strkur, "GBP") + 53, 9)
Text11.Text = Mid(strkur, InStr(strkur, "CHF") + 41, 7)
Text12.Text = Mid(strkur, InStr(strkur, "CHF") + 53, 9)
Text13.Text = Mid(strkur, InStr(strkur, "SEK") + 41, 7)
Text14.Text = Mid(strkur, InStr(strkur, "SEK") + 53, 9)
Text15.Text = Mid(strkur, InStr(strkur, "CAD") + 41, 7)
Text16.Text = Mid(strkur, InStr(strkur, "CAD") + 53, 9)
Text17.Text = Mid(strkur, InStr(strkur, "KWD") + 41, 7)
Text18.Text = Mid(strkur, InStr(strkur, "KWD") + 53, 9)
Text19.Text = Mid(strkur, InStr(strkur, "NOK") + 41, 7)
Text20.Text = Mid(strkur, InStr(strkur, "NOK") + 53, 9)
Text21.Text = Mid(strkur, InStr(strkur, "SAR") + 41, 7)
Text22.Text = Mid(strkur, InStr(strkur, "SAR") + 53, 9)
Text23.Text = Mid(strkur, InStr(strkur, "JPY") + 41, 7)
Text24.Text = Mid(strkur, InStr(strkur, "JPY") + 53, 9)
Text25.Text = Mid(strkur, InStr(strkur, "BGL") + 41, 7)
Text26.Text = Mid(strkur, InStr(strkur, "BGL") + 53, 9)
Text27.Text = Mid(strkur, InStr(strkur, "SYP") + 41, 7)
Text28.Text = Mid(strkur, InStr(strkur, "SYP") + 53, 9)
Text29.Text = Mid(strkur, InStr(strkur, "JOD") + 41, 7)
Text30.Text = Mid(strkur, InStr(strkur, "JOD") + 53, 9)
Text31.Text = Mid(strkur, InStr(strkur, "ILS") + 41, 7)
Text32.Text = Mid(strkur, InStr(strkur, "ILS") + 53, 9)
Text33.Text = Mid(strkur, InStr(strkur, "IRR") + 41, 7)
Text34.Text = Mid(strkur, InStr(strkur, "IRR") + 53, 9)
End Sub

OG Notu: Arkadaşlar ben denedim güzel çalışıyor. Kurların içinden gerekli olanları secebilirsiniz. Alınan değerler "Döviz Alış" "Döviz Satış" sırası iledir. "Efektif Alış ve Satış" olarak kullanmak isterseniz 41 değerini 70 , 53 değerini 81 ile değiştirmeniz gerekir.

[OG]

Common Dialoglarda Birden Fazla Dosya türünü Açmak İstediğinizde

CommonDialog.InitDir = App.path
CommonDialog.DialogTitle = "Select Multi Page TIFF"
CommonDialog.DefaultExt = "*.TIF"
CommonDialog.filter = "TIF Files|*.TIF|TIFF Files|*.TIFF"

gibi araya | işareti koyarak farklı dosya tiplerini veya açıklamalar yazabilirsiniz..

[OG]

İnet nesnesi ile pc kontrolü

İnet nesnesi ile pc kontrolune basit bir ornek vermek istedim

Mantık Şu inet ile programimiz belirledigimiz txt dosyasina bağlanarak orda ki yazılanı kontrol
ederek İşlem yapması........

Formumuza 1 Inet nesnesi 1 Timer ve 1 tane de textbox ekliyoruz (timer intervalı 1000 olmalı)


Öncelikle free bir host ediniyoruz.Daha sonra icine kendi belirledigimiz bir isimde txt dosyasi
koyuyoruz.Txt dosyasina Benim yaptıgımın programda "Kapan" dedim ama siz istediginizi yazabilirsiniz...


Private Sub Timer1_Timer()
Text1.Text = Inet1.OpenURL("http://www.orneksite.com/ornek.txt")
If Text1.Text = "Kapan" Then 'Kapan yerine sitenizdeki txt dosyasındaki komutu yazın.
Shell "shutdown.exe -s", vbNormalFocus 'Herhangibir komut yazın.

End If

End Sub

[OG]

Windows, System v.s klasörlerinin yerini, bilgisayar ismi, domain adı v.s

" Environ komutu ve özellikleri "

Benim gördüğüm bu kodla tanışmayan bir çok programcı arkadaş Windows, System v.s klasörlerinin yerini, bilgisayar ismi, domain adı v.s gibi bilgileri apilerle birden fazla satır kodlarla ulaşır. İşte size Environ komutu.
Tek satır kodla çok güzel sonuçlar elde edebilirsiniz.

Tabi bu Environ komutundan sonuç elde etmek için bazı parametrelere ihtiyaç duyar bu parametrelerin bazılarını aşağıya yazdım.

Kullanımı ;

Dim winyol
Winyol = Environ("WinDir") ‘işte bu satırla Windows klasörünün yolunu buluruz..
Text1.text= winyol

İşte bazı parametreler;
COMPUTERNAME=RIFAT ‘bilgisayar isminiz
ComSpec=C:\WINDOWS\system32\cmd.exe ‘Ms-Dos kontrol paneli yolu
HOMEDRIVE=C: ‘Geçerli işletim sisteminin yüklü olduğu sürücü
HOMEPATH=\Documents and Settings\Administrator ‘Geçerli kullanıcının kullanıcı klasörü
LOGONSERVER=\\RIFAT ‘Pc nin kullandığı server adı
OS=Windows_NT Â‘İşletim sistemi türü
USERDOMAIN=RIFAT ‘Veri alışverişi yaptığı domain ismi
USERNAME=Administrator ‘Kullanıcı ismi
USERPROFILE=C:\Documents and Settings\Administrator ‘Açık olan kullanıcı profilinin klasörü
windir=C:\WINDOWS ‘Windows klasörü

Diğer bütün parametreleri görmek için Ms-Dos komutunda set yazıp enter tıklayın.

Private Sub Form_Load()
' bu şekildede bütün özelliklerini text2 ye aktarabilirsiniz
Dim i As Integer
Dim txt As String

For i = 1 To 10000
If Environ(i) <> "" Then
txt = txt & Environ(i) & vbCrLf
Else
Exit For
End If
Next i
Text2.Text = txt
End Sub

[OG]

Programınızı Regedit'e Kaydettirin

Açıklama : Eğer yaptığınız bir programda visual basic′in .ocx′leri veya dll′leri veya ekstradan oluşturduğunuz .ocx′ler veya dll′ler başka bilgisayarlarda çalışmıyorsa bunu şu şekilde düzeltebilirsiniz.Bu yöntemle Programınızda kullandığınız .ocx′ler veya dll′ler aşağıdaki kodlar sayesinde regedite kaydedilecek ve programınız bi daha hata vermiyecektir.Bu kodları programınızın load eventine yazabilirsiniz.

* Formunuza 3 adet text kutusu koyun (ben örnek göstermek için 3 tane koydum siz daha fazla .ocx′siniz veya dll′liniz varsa o kadar eklersiniz), 1 tanede command button koyun.

* Text1′e ocx′sinizin yolunu yazın, text2′yede dll′linizin yolunu yazın.

Not:Aşağıdaki kodları direk forma yapıştırıp çalıştırırsanız, daha iyi anlarsınız.

Private Sub Form_Load()
Text1.Text = "regsvr32" & " " & Chr(34) & App.Path & Chr(92) & "mscomctl.ocx" & Chr(34) & " " & "/s"
Text2.Text = "regsvr32" & " " & Chr(34) & App.Path & Chr(92) & "msvbvm60.dll" & Chr(34) & " " & "/s"
End Sub

Private Sub Command1_Click()
Call Shell(Text1.Text)
Call Shell(Text2.Text)
End Sub

* Yukarıdaki /s ne anlama geliyor, hemen onu belirtiyim.Eğer onları koymazsanız yine kaydolur fakat size kaydoldu diye bi uyarı penceresi gelir(isterseniz bi de öyle yaparak deneyin), eğer koyarsanız o uyarı penceresi gelmeden kaydolur ve buda programın daha hoş durmasını sağlar.