Mustafa KULLUKÇUOĞLU Kişisel Günlük

Windows 7 sysprep ve Default Profil Kopyalama

Mustafa — Thu, 12 Apr 2012 20:07:10 +0000

Windows 7 üzerinde sysprep uygularken xp de rahatlıkla yaptığımız varsayılan profili kopyalama işlemleri yapılamamakta. Alternatif küçük bir yazılım ise bunu mümkün kılıyor.

Sysprep öncesi bir windows 7 kurulumu yapıp gerekli tüm yazılımları kurup, kopyalayacağımız profil üzerinde tüm ayarları yaptıktan sonra aşağıdaki işlemleri uyguluyoruz.

Windows Enabler isimli uygulamayı buradan indiriyoruz ve programı Runas ile açıyoruz. Taskbar üzerinde program açılıyor.

Sonra kullanıcı profil yönetimine (Sistem özelliklerinde Gelişmiş Sekmesine geçip, Kullanıcı Profillerinin Ayarlar menüsüne) giriyoruz. Kopyalayacağımız kullanıcının üzerindeyken Copy To pasif te olsa üzerine bir defa tıklıyoruz. Sonra açtığımız Windows Enabler yazılımının üzerine bir defa tıkladığımızda yazılım üzerinde ON ibaresi beliriyor. Tekrar pasif Copy To seçeneğine tıkladığımızda kopyala aktif oluyor. Şimdi kopyalam işlemi için path bölümüne C:\User\Default yazıp tamam dediğimizde klasör üzerine işlemi gerçekleşmekte. Bundan sonra oluşturulacak tüm kullanıcılar bu profilin kopyası olarak oluşturulacaktır.

ve sysprep.exe /generalize /oobe /shutdown > IMAGE

Yazılım Windows 7 x64 Pro üzerinde denedim işe yaramakta.

Kolay gelsin.

Yazılımı öğrendiğim kaynak : http://www.wincert.net/tips/microsoft-windows/windows-7/2109-how-to-copy-a-user-profile-on-windows-7.html

Symantec Brightmail Gateway ile kelime filtreleme

Mustafa — Mon, 21 Nov 2011 11:17:03 +0000

Spam çözümlerinden önde gelen Symantec BrightMail Gw ile belirli kelime içeren epostaların karantinaya alınması veya silinmesini aşağıdaki adımlar ile tamamlayabiliriz.

Öncelikle bir sözlük tanımlaması yapıyoruz, bu sözlüğün içine içerebilecek kelimeleri tek tek ekliyoruz. Kelimenin bir bölümünün olması yeterlidir.

Örn:

Brightmail Sözlük Ekleme

Sözlüğümüzü ektedikten sonra sıra bu kelimeleri içeren bir eposta geldiğinde ne yapmalıyızı tanımlamaya.

Brightmail Politika Ekleme1

Boş bir politika seçerek başlıyoruz.

Brightmail Politika Ekleme

Gelen epostaların Konu, Body ve eklerinde Seçtiğimiz kategoriden 2 veya daha fazla kelime içermesi durumunda bu politika geçerli olacaktır.

Brightmail Politika Ekleme

Birden fazla conditionsu tek bir politika içerisine yazabileceğimiz gibi birden fazla politikayı da gelen epostalara uygulayabiliriz. Örnekte, Gelen epostaların konu ve içeriğinde Kufurler sözlüğünde yer alan 2 sözcük veya daha fazla içermesi durumunda Epostayı karantina havuzuna atıyoruz.

Brightmail Politika Ekleme

İyi çalışmalar.

Office Update sonrası Excel yavaşlığı & Vbscript ile uzaktan komut çalıştırma/patch kaldırma

Mustafa — Fri, 01 Jul 2011 12:14:43 +0000

28.06.2011 tarihinde çıkan Microsoft Office File Validation güncellemesi yükledikten sonra ağ üzerinden excel dosyalarını açarken aşırı bir yavaşlama ve 2-3Mb boyutundan yüksek olan excel dosyalarında kilitlenme meydana gelmesine yol açmakta. Bilgisayarın lokal disklerinde bulunan dosyalar için bu sorun olmamakla birlikte yanlızca ağ üzerinden çalışan dosyalarda bu sorun ortaya çıkmakta.

Yapılan güncelleme WSUS ortamından kaldırılmayı desteklemediği için elle kaldırmanız gerekmekte 5-10 bilgisayar yapılabilir ancak şirket ortamları için pek mümkün değil.

iş yine script yazmaya kaldı.
Öncelikle nasıl kaldırabileceğimizi registry üzerinden aradığımızda kaldırma stringi olarak
MsiExec.exe /I{90140000-2005-0000-0000-0000000FF1CE} yazmakta kendimize göre düzenlersek MsiExec.exe /quiet /uninstall {90140000-2005-0000-0000-0000000FF1CE} şeklinde interaktif ekran görünmeden otomatik olarak kaldırması sağlanmakta.

Güncelleme: Microsoft tarafında sorun çıktığı teyit edilmiş ilgili adreslere http://support.microsoft.com/kb/2570623/tr ve http://support.microsoft.com/kb/2501584/tr adreslerinden ulaşılabilir. 3 çözüm sunmuşlar şu anlık 1.Kaldırmak 2. Devre dışı bırakmayı, Office 2007 veya 2010 yüklemeyi. İlgili linklerden detaylara ulaşabilirsiniz.

Gelelim Scripte.

On Error Resume Next

Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 1000

dim strCommand ' Microsoft Office File Validation Add-in kaldirma değerleri strCommand = "MsiExec.exe /quiet /uninstall {90140000-2005-0000-0000-0000000FF1CE}"

‘ oluşan logları kayıt edelim.
Set oFSO = CreateObject(“Scripting.FileSystemObject”)
Set oLog = oFSO.CreateTextFile(“JobExport.Log”)

‘ Hesabı kapalı olmayan bilgisayarları bulalım
objCommand.CommandText = “;(&(objectCategory=computer) (!(userAccountControl:1.2.840.113556.1.4.803:=2)));Name;subtree”
Set objRecordSet = objCommand.Execute
dim objComputer
objRecordSet.MoveFirst

'Bilgisayar kayıtları sona gelene kadar her bilgisayar için komutumuzu çalıştıralım Do Until objRecordSet.EOF

objComputer = "" objComputer = objRecordSet.Fields("Name").Value 'Bilgisayarin kapalı mı açık mı olduğunu anlamak için ping atalım Set objScriptExec = objShell.Exec("ping -n 2 -w 1000 " & objComputer) strPingResults = LCase(objScriptExec.StdOut.ReadAll) 'Gelen cevapta türkçe sistemler için cevab ingilizceler için Reply içeriyorsa komut çalıştıralım If InStr(strPingResults, "cevab") or InStr(strPingResults, "Reply") Then Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & objComputer & "\root\cimv2") Set objProcess = objWMIService.Get("Win32_Process") errReturn = objProcess.Create(strCommand, null, null, intProcessID) If errReturn = 0 Then olog.write objComputer & ";Software Runned. ID=; " & intProcessID & vbcrlf Else olog.write objComputer & ";Error ID; " & errReturn & vbcrlf End If Else olog.write("Bilgisayar Kapalı" & vbcrlf) End If 'Next Computer objRecordSet.MoveNext

Loop olog.Close msgbox "END OF SCRIPT"

İyi çalışmalar.

Adobe Flash Hazır MSI Paketi

Mustafa — Mon, 14 Feb 2011 14:08:37 +0000

Etki alanındaki tüm bilgisayarlara Adobe Flash güncellemesi için gerekli güncel MSI dosyalarını bizim oluşturmamıza gerek bulunmamakta. Bu konuda Adobe firması bize destek sağlıyor.

http://www.adobe.com/tr/products/players/flash-player-distribution.html adresinde yer alan link üzerinden eposta adresiniz ile kayıt olduğunuz takdirde size hangi adresi kullanarak indirebileceğiniz bilgisini iletmekteler.

Not: Daha önce eklediğim linkleri kaldırdım. Flash 11 için yeni dağıtım linkleri iletiyorlar sizde kayıt olarak ilgili dosya linklerine erişebilirsiniz..

Exchange 2003 Yönetici Şifre Değişikliği Sonrası Event ID 529 & 8213

Mustafa — Fri, 04 Feb 2011 12:35:08 +0000

Birçok eklenti, 3rd parti yazılımlar kurulmuş bir exchange sunucunun bağlı olduğu domainde Administrator parolası değiştirdikten sonra eğer Event ID 529 ve 8213 düşüyorsa.

Öncelikle Administrator hesabı ile çalışan bir exchange servisi var mı kontrol ettikten sonra eğer yoksa aşağıdaki makaledeki işlemler sorunumuzu çözüyor.

Örnek Hata Logları

Event Type: Failure Audit
Event Source: Security
Event Category: Logon/Logoff
Event ID: 529
Date: 27.01.2011
Time: 16:30:05
User: NT AUTHORITY\SYSTEM
Computer: MAILSUNUCU
Description:
Logon Failure:
Reason: Unknown user name or bad password
User Name: Administrator
Domain: DOMAIN
Logon Type: 7
Logon Process: Advapi
Authentication Package: Negotiate
Workstation Name: MAILSUNUCU
Caller User Name: MAILSUNUCU$
Caller Domain: DOMAIN
Caller Logon ID: (0×0,0x3E7)
Caller Process ID: 3780 (mad.exe)
Transited Services: -
Source Network Address: -
Source Port: -

For more information, see Help and Support Center at http://go.microsoft.com/fwlink/events.asp.

Birde Application log içerisine aşağıdaki log düşüyor?

Event Type: Error
Event Source: MSExchangeFBPublish
Event Category: General
Event ID: 8213
Date: 1/27/2011
Time: 4:20:05 PM
User: N/A
Computer: MAILSUNUCU
Description:
System Attendant Service failed to create session for virtual machine MAILSUNUCU. The error number is 0xc007052e.

Çözüm;
http://support.microsoft.com/kb/296151/en

1. Start Registry Editor.
2. Locate the Server value under the following key in the registry:
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\MSExchangeFBPublish\Parameters\
3. On the Edit menu, click Add Value.
4. In the Value Name field, type FreeBusyQuerySessions, set the Data Type to REG_DWORD, and then click OK.
5. In the Data field, type 00000000, and then click OK.
6. Quit Registry Editor.
7. Restart the Microsoft Exchange System Attendant.
8. Start Exchange System Manager, and then locate the storage group.
9. Click the private store, and then right-click Properties.
10. Click the Security tab, and then click the Exchange service account.
11. Click View information store, click Administer information store, and then set the permissions.
12. Reset the Administrative Group’s service account.

To reset the Administrative Group’s service account, follow these steps:

1. Back up the Exchange Server 2003 or Exchange 2000 Server information store and the Windows system state data of a domain controller.
2. Start the ADSI Edit tool.
3. Expand Configuration Container [domain name], expand CN=Configuration,DC=Domain_name, expand CN=Services, expand CN=MicrosoftExchange, expand CN=Organization_Name, and then expand CN=Administrative Groups
4. Right-click CN=Your Admin Group Name, and then click Properties.
5. Click the Attribute Editor tab.
6. Double-click the following properties, note the value if there is a value in the property, and then click the CLEAR button:
* msExchEncryptedPassword
* msExchLegacyAccount
* msExchLegacyDomain
7. Double-click msExchAdminGroupMode.
8. Type 2 for the value.

Note Before you change the value to 2, note the original value.
9. Click OK, click Apply, and then click OK.
10. Quit the ADSI Edit tool.
11. Restart the Microsoft Exchange System Attendant service and all dependent services.

Vb.net İle Web Sayfaları üzerinde Get-Post istekleri yapmak ve Excel işlemleri

Mustafa — Thu, 21 Oct 2010 19:27:07 +0000

Güzel bir programla/notlarla yeni bir post.

Programın,notların işlemleri;
Vb.net kullanarak Web sayfalarını getirmek veya web sayfalarına değerler post ederek gelen değerleri almak. Alınan verileri excel dosyası oluşturup ilgili sütün/satırlara yazıp biçimlendirmeleri (hücre birleştirme,renklendirme) yapıp kayıt etmek.

Programın yaptıkları;
1-İzmir metro seferlerini www.izmir.bel.tr adresinden Get ile alıp kaynak kodunu temizledikten sonra excele aktarıp kayıt etmek
2-İzmir banliyo seferlerini www.izban.com.tr adresinden alıp kayıt etmek.
3-Vapur seferlerini www.izmir.bel.tr ulaşımdaki vapur alanında bulunan kalkış ve varış comboboxları içerisindeki değerlerin hepsini tek tek post ederek gelen değerlere göre sefer varsa excele atmak
4-Otobüs numaralarını kullanarak www.eshot.gov.tr sitesinden her bir otobüs numarası için güzergah,saatlerini alıp excele kayıt etmek.

Kısaca izmir offline ulaşım rehberi.

Programın tam proje dosyasını indirmek için tıklayınız (vs 2005)

Imports System.Net Imports System.Text Imports System.IO Imports Microsoft.Office.Core Imports System.Threading Imports System.Runtime.InteropServices Public Class Form1 Shared threadcount As Integer = 0 Shared path As String = "" Dim bitti As Boolean = False Shared sonalinan As String = "" Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Control.CheckForIllegalCrossThreadCalls = False End Sub


    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnotobus.Click

        If IsNumeric(txtotobusilk.Text) And IsNumeric(txtotobusson.Text) Then

            If Val(txtotobusilk.Text) > Val(txtotobusson.Text) Then

                MsgBox("İlk otobüs son otobüs numarasından büyük olamaz")

                Exit Sub

            End If

        Else

            MsgBox("Lütfen otobüs numarası alanlarına rakam giriniz")

            Exit Sub

        End If

        DirectoryCheck()

        path = txtpath.Text

        Dim thbaslat As Thread

        Dim thkbaslat As New ThreadStart(AddressOf OtobusTaramaBaslat)

        thbaslat = New Thread(thkbaslat)

        thbaslat.Start()

    End Sub

    Private Sub OtobusTaramaBaslat()

        bitti = False

        Dim thistatistik As Thread

        Dim thkistatistik As New ThreadStart(AddressOf SbIstatistik)

        thistatistik = New Thread(thkistatistik)

        thistatistik.Start()

        Dim alinansayisi As Integer = 0

        btnotobus.Enabled = False

        System.IO.Directory.CreateDirectory(path & "\Otobus")

        For i As Integer = Val(txtotobusilk.Text) To Val(txtotobusson.Text)

            lblcalisilan.Text = i.ToString

tekrar:

            If threadcount >= Val(txtmaxthread.Text) Then

                Thread.Sleep(500)

                GoTo tekrar

            End If
            Dim otobusclass As New OtobusTara

            otobusclass.otobusno = i

            Dim thsoft As New Thread(AddressOf otobusclass.Otobusbulyaz)

            thsoft.IsBackground = True

            thsoft.Priority = ThreadPriority.Normal

            thsoft.Start()

            Interlocked.Increment(threadcount)

            Thread.Sleep(500)

        Next

        bitti = True

        btnotobus.Enabled = True

        'Call ProcessKill()

        lblsondurum.Text = "Sefer alım threadları tamamlandı" & vbCrLf & _

        "Çalışan threadların sonlanması bekleniyor"

    End Sub

    Private Sub SbIstatistik()

bas:

        If threadcount = 0 And bitti = True Then

            lblthreadcount.Text = threadcount

            lblsondurum.Text = "Sefer Alımları Tamamlandı" & vbCrLf & _

      "Bazı excel prosesleri takılı kalmış olabilir" & vbCrLf & _

      "Biraz bekledikten sonra excel işlemlerini sonlandırabilirsiniz"

            Exit Sub

        Else

            lblalinan.Text = sonalinan

            lblthreadcount.Text = threadcount

            Thread.Sleep(100)

            GoTo bas

        End If

    End Sub

    Public Class OtobusTara

        Public otobusno As Integer

        Public Sub Otobusbulyaz()

            Dim kaynakkodu As String = ""

            Dim kaynak As String = ""

            Dim guzergah As String = ""

            Try

                Dim istek As HttpWebRequest = HttpWebRequest.Create("http://www.eshot.gov.tr/otobushareket/OtobusSaatleri.aspx?hatno=" & otobusno.ToString)

                Dim cevap As HttpWebResponse = istek.GetResponse

                Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream())

                kaynak = sr.ReadToEnd()

            Catch ex As WebException

                MsgBox("Web sayfası alınırken sorun oluştu" & vbCrLf & ex.Message)

                GoTo cikis

            End Try
            If Not (InStr(kaynak, "Hat No") > 0) Then

                'Otobüs yok

                GoTo cikis

            End If

            Dim baslangictext As String = ""

            Dim bitistext As String = "
            Dim tablobas As Integer = InStr(kaynak, baslangictext)

            If tablobas = 0 Then

                'Otobüs yok

                GoTo cikis

            End If

            Dim guzergahbas As Integer = InStr(kaynak, "") + 22

            Dim guzergahson As String = InStr(kaynak, "
") + 61)

            guzergah = Mid(kaynak, guzergahbas, guzergahson)
            Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) - tablobas), bitistext) - 20

            kaynakkodu = Mid(kaynak, tablobas, tabloson)

            kaynakkodu = Replace(kaynakkodu, Chr(13), "")

            kaynakkodu = Replace(kaynakkodu, Chr(10), "")

            kaynakkodu = Replace(kaynakkodu, "  ", "")

            kaynakkodu = Replace(kaynakkodu, "	", "")

            kaynakkodu = Replace(kaynakkodu, "", "")

            kaynakkodu = Replace(kaynakkodu, "</td>", ";")

            kaynakkodu = Replace(kaynakkodu, "</td></tr>", Chr(13))

            kaynakkodu = Replace(kaynakkodu, "</td></tr>", Chr(13))

            kaynakkodu = Replace(kaynakkodu, "</td></tr></table></div></td>
", Chr(13))

            kaynakkodu = Replace(kaynakkodu, "</td></tr></table></div></td>", Chr(13))

            kaynakkodu = Replace(kaynakkodu, "</th></tr>
", Chr(13))

            kaynakkodu = Replace(kaynakkodu, "</th>", ";")

            kaynakkodu = Replace(kaynakkodu, "</td></tr></table></div></td></tr></table> ", "")
            kaynakkodu = Replace(kaynakkodu, "Ç", "C")

            kaynakkodu = Replace(kaynakkodu, "Ü", "U")

            kaynakkodu = Replace(kaynakkodu, "ı", "i")

            kaynakkodu = Replace(kaynakkodu, "ş", "s")

            kaynakkodu = Replace(kaynakkodu, "Ö", "Ö")

            kaynakkodu = Replace(kaynakkodu, "G?zergah", "Guzergah")

            kaynakkodu = Replace(kaynakkodu, "KAR?", "KARS")

            kaynakkodu = Replace(kaynakkodu, "ş", "s")

            kaynakkodu = Replace(kaynakkodu, " ", " ")
            Dim oXL As Excel.Application

            Dim oWB As Excel.Workbook

            Dim oSheet As Excel.Worksheet
            oXL = CreateObject("Excel.Application")

            oXL.Visible = False
            oWB = oXL.Workbooks.Add

            oSheet = oWB.ActiveSheet
            Dim satirlar() As String = Split(kaynakkodu, Chr(13))

            Dim cumartesi As Boolean = False

            Dim pazar As Boolean = False

            Dim cumartesisayisi As Integer = 0

            Dim pazarsayisi As Integer = 0

            oSheet.Cells(1, 1) = guzergah

            For i As Integer = 0 To satirlar.Length - 1

                Dim satir As String = satirlar(i).ToString

                Dim ogeler() As String = Split(satir, ";")

                If ogeler.Length < 2 Then Exit For

                If InStr(ogeler(0), "Kalkış") And i > 5 And cumartesi = True Then

                    cumartesi = False

                    pazar = True

                End If

                If InStr(ogeler(0), "Kalkış") And i > 5 And cumartesi = False And pazar = False Then

                    cumartesi = True

                End If

                If cumartesi = True Then

                    oSheet.Cells(cumartesisayisi + 2, 3) = ogeler(0)

                    oSheet.Cells(cumartesisayisi + 2, 4) = ogeler(1)

                    cumartesisayisi += 1

                End If

                If pazar = True Then

                    oSheet.Cells(pazarsayisi + 2, 5) = ogeler(0)

                    oSheet.Cells(pazarsayisi + 2, 6) = ogeler(1)

                    pazarsayisi += 1

                End If

                If cumartesi = False And pazar = False Then

                    oSheet.Cells(i + 2, 1) = ogeler(0)

                    oSheet.Cells(i + 2, 2) = ogeler(1)

                End If

            Next

            If cumartesisayisi > 0 Then

                ' Eğer cumartesi günü sefer varsa C2 den başlayıp

                ' Cumartesi günü sonuna kadar renklendirelim

                With oSheet.Range("C2", "D" & cumartesisayisi + 1)

                    '.Font.Bold = True

                    .Interior.ColorIndex = 17

                    .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

                End With

            End If

            With oSheet.Range("A1", "F1")

                ' Otobüs guzergahını biçimlendirelim

                .Merge()

                .Font.Size = 7

                .Font.Bold = True

                .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

            End With

            With oSheet.Range("A2", "F2")

                ' Başlık bilgilerini biçimlendirelim

                .WrapText = True

                .ColumnWidth = 10

                .Font.Size = 7

                .Font.Bold = True

                .Interior.ColorIndex = 13

                .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

                .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

                .EntireColumn.AutoFit()

            End With

            With oSheet.Range("A3", "F253")

                .Font.Size = 9

                .EntireColumn.AutoFit()

                .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

                .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

            End With
            Dim dosyaadi As String = otobusno & "-" & Replace(oSheet.Cells(2, 1).Value.ToString, " Kalkış", "") & "-" & Replace(oSheet.Cells(2, 2).value.ToString, " Kalkış", "") & "(" & guzergah & ")" & ".xls"

            If Len(dosyaadi) > 150 Then

                dosyaadi = otobusno & "-" & Replace(oSheet.Cells(2, 1).Value.ToString, " Kalkış", "") & "-" & Replace(oSheet.Cells(2, 2).value.ToString, " Kalkış", "") & "(" & Mid(guzergah, 1, 100) & ")" & ".xls"

            End If

            If System.IO.File.Exists(path + "\Otobus\" + dosyaadi) Then

                Dim cvp = MessageBox.Show("Kayıt edilmeye çalışılan dosya mevcut üzerine yazılsın mı?" & vbCrLf & "Dosyaadı:" & path + "\Otobus\" + dosyaadi, "Dosya Mevcut", MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)

                If cvp = vbYes Then

silveuzerineyaz:

                    'Dosya mevcutsa eski dosyayı silelim

                    Try

                        System.IO.File.Delete(path + "\Otobus\" + dosyaadi)

                    Catch ex As IOException

                        MsgBox("Dosya üzerine yazılırken hata oluştu" & vbCrLf & ex.Message)

                        Exit Sub

                    End Try

                Else

                    Dim yenidosyaadi As String = ""

                    yenidosyaadi = InputBox("Dosya Adını Giriniz iptal demeniz durumunda dosya kayıt edilmeyecektir", "Yeni Adı Gir", dosyaadi)

                    If yenidosyaadi = "" Or yenidosyaadi = dosyaadi Then

                        GoTo cikis

                    ElseIf yenidosyaadi <> dosyaadi Then

                        If InStr(yenidosyaadi, ".xls") = 0 Then yenidosyaadi += ".xls"

                        dosyaadi = yenidosyaadi

                    End If

                End If

            End If

            oSheet.SaveAs(path + "\Otobus\" + dosyaadi)

            oWB.Close(False)

            oXL.Workbooks.Close()

            oXL.Quit()

            sonalinan = otobusno

cikis:

            Interlocked.Decrement(threadcount)

        End Sub
    End Class
    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnvapur.Click

        DirectoryCheck()

        path = txtpath.Text

        Dim thbaslat As Thread

        Dim thkbaslat As New ThreadStart(AddressOf VapurTara)

        thbaslat = New Thread(thkbaslat)

        thbaslat.Start()

    End Sub
    Private Sub VapurTara()

        System.IO.Directory.CreateDirectory(path & "\Vapur")

        btnvapur.Enabled = False

        ' Programın çalışma aşamaları

        ' İzmir belediyesinin vapur.asp sayfasına bağlanıp

        ' Kalkış ve varış comboboxlarındaki değerler alındıktan sonra.

        ' Her  kalkış noktasından her varış noktası için

        ' değerleri post edip gelen değerlere göre eğer vapur var ise

        ' kalkış ve varış noktalarına göre xls dosyası oluşturmakta.

        Dim kaynak As String = ""

        Dim kalkis As String = ""

        Dim varis As String = ""

        Try

            Dim istek As HttpWebRequest = HttpWebRequest.Create("http://www.izmir.bel.tr/vapur.asp")

            Dim cevap As HttpWebResponse = istek.GetResponse

            Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream(), Encoding.GetEncoding("windows-1254"))

            kaynak = sr.ReadToEnd()

        Catch ex As WebException

            MsgBox("Web sayfası alınırken sorun oluştu" & vbCrLf & ex.Message)

            GoTo cikis

        End Try
        Dim baslangictext As String = ""

        bitistext = "
"

                            baslangictext = ""

        Dim bitistext As String = "</tbody>"

        Dim tablobas As Integer = InStr(kaynak, baslangictext)

        If tablobas = 0 Then

            'tablo bulunamadı

            GoTo cikis

        End If

        Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) - tablobas), bitistext) - 20

        kaynakkodu = Mid(kaynak, tablobas, tabloson)

        kaynakkodu = Replace(kaynakkodu, Chr(13), "")

        kaynakkodu = Replace(kaynakkodu, Chr(10), "")

        kaynakkodu = Replace(kaynakkodu, "  ", "")

        kaynakkodu = Replace(kaynakkodu, "	", "")

        kaynakkodu = Replace(kaynakkodu, "</tr>", Chr(13))

        kaynakkodu = Replace(kaynakkodu, "", "")

        kaynakkodu = Replace(kaynakkodu, "", "")

        kaynakkodu = Replace(kaynakkodu, "", "")

        kaynakkodu = Replace(kaynakkodu, "</font>", "")

        Dim satirlar() As String = Split(kaynakkodu, Chr(13))
        Dim oXL As Excel.Application

        Dim oWB As Excel.Workbook

        Dim oSheet As Excel.Worksheet
        oXL = CreateObject("Excel.Application")

        oXL.Visible = False
        oWB = oXL.Workbooks.Add

        oSheet = oWB.ActiveSheet

        oSheet.Cells(1, 1) = "Alsancak Kalkış"

        oSheet.Cells(1, 2) = "Cumaovası Kalkış"

        For i As Integer = 1 To satirlar.Length - 1

            Dim ilkhucre As String = ""

            Dim sonhucre As String = ""

            Dim s As String = satirlar(i)

            tablobas = InStr(s, "") + 8

            tabloson = InStr(s, "</strong>")

            ilkhucre = Mid(s, tablobas, tabloson - tablobas)

            s = Mid(s, tabloson + 20, s.Length - tabloson)

            tablobas = InStr(s, "") + 8

            tabloson = InStr(s, "</strong>")

            If tabloson = 0 Then

                sonhucre = " "

            Else

                sonhucre = Mid(s, tablobas, tabloson - tablobas)

            End If

            oSheet.Cells(i + 1, 1) = ilkhucre

            oSheet.Cells(i + 1, 2) = sonhucre

        Next

        With oSheet.Range("A1", "B253")

            .WrapText = True

            .ColumnWidth = 10

            .Font.Size = 9

            .EntireColumn.AutoFit()

            .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

            .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

        End With

        If System.IO.File.Exists(path & "\Banliyo\Seferler.xls") Then

            Dim cvp = MessageBox.Show("Banliyo seferleri daha önce kayıt edilmiş?" & vbCrLf & "Dosyaadı:" + path & "\Banliyo\Seferler.xls", "Dosya Mevcut", MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)

            If cvp = vbYes Then

silveuzerineyaz:

                'Dosya mevcutsa eski dosyayı silelim

                Try

                    System.IO.File.Delete(path & "\Banliyo\Seferler.xls")

                Catch ex As IOException

                    MsgBox("Dosya üzerine yazılırken hata oluştu" & vbCrLf & ex.Message)

                    lblsondurum.Text = "Banliyo seferleri yazılamadı"

                    oWB.Close()

                    oXL.Quit()

                    Exit Sub

                End Try

            End If

        End If

        oWB.SaveAs(path & "\Banliyo\Seferler.xls")

        oWB.Close()

        oXL.Quit()
cikis:

        lblsondurum.Text = "Banliyo seferleri alımı tamamlandı..."

    End Sub
    Private Sub btnmetro_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnmetro.Click

        DirectoryCheck()

        path = txtpath.Text

        Dim thbaslat As Thread

        Dim thkbaslat As New ThreadStart(AddressOf MetroTara)

        thbaslat = New Thread(thkbaslat)

        thbaslat.Start()

    End Sub

    Private Sub MetroTara()

        lblsondurum.Text = "Metro seferleri alınıyor..."

        System.IO.Directory.CreateDirectory(path & "\Metro")

        Dim kaynakkodu As String = ""

        Dim kaynak As String = ""

        Try

            Dim istek As HttpWebRequest = HttpWebRequest.Create("http://www.izmir.bel.tr/metro.asp")

            Dim cevap As HttpWebResponse = istek.GetResponse

            Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream(), Encoding.GetEncoding("windows-1254"))

            kaynak = sr.ReadToEnd()

        Catch ex As WebException

            MsgBox("Web sayfası alınırken sorun oluştu" & vbCrLf & ex.Message)

            GoTo cikis

        End Try
        If InStr(kaynak, "SEFER SIKLIKLARI") = 0 Then

            'Sayfada gerekli veri yok

            GoTo cikis

        End If

        Dim baslangictext As String = "Kalkış</b></td>"

                            bitistext = "</table>"

                            tablobas = 0

                            tablobas = InStr(kaynak, baslangictext)

                            tabloson = 0

                            tabloson = InStr(Mid(kaynak, tablobas, Len(kaynak) - tablobas), bitistext) - 20

                            Dim vapurseferleri As String = Mid(kaynak, tablobas, tabloson)

                            vapurseferleri = Replace(vapurseferleri, "Ç", "C")

                            vapurseferleri = Replace(vapurseferleri, "Ü", "U")

                            vapurseferleri = Replace(vapurseferleri, "ı", "i")

                            vapurseferleri = Replace(vapurseferleri, "ş", "s")

                            vapurseferleri = Replace(vapurseferleri, "G?zergah", "Guzergah")

                            vapurseferleri = Replace(vapurseferleri, "KAR?", "KARS")

                            vapurseferleri = Replace(vapurseferleri, "ş", "s")

                            vapurseferleri = Replace(vapurseferleri, " ", " ")

                            vapurseferleri = Replace(vapurseferleri, "  ", "")

                            vapurseferleri = Replace(vapurseferleri, "  ", "")

                            vapurseferleri = Replace(vapurseferleri, "	", "")

                            vapurseferleri = Replace(vapurseferleri, Chr(10), "")

                            vapurseferleri = Replace(vapurseferleri, Chr(13), "")

                            vapurseferleri = Replace(vapurseferleri, " ", "")

                            vapurseferleri = Replace(vapurseferleri, "</b></td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</b></td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</b></td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</b></td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "
", "")

                            vapurseferleri = Replace(vapurseferleri, "</td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</td>  ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</td> ", ";")

                            vapurseferleri = Replace(vapurseferleri, "</td></tr>", Chr(13))

                            vapurseferleri = Replace(vapurseferleri, "</b>", "")
                            Dim seferler() As String = Split(vapurseferleri, Chr(13))

                            ' En fazla kaç satır çıkmış onu excel renklendirme için alalım

                            If seferler.Length > vapurhareketsayisi Then vapurhareketsayisi = seferler.Length

                            For p As Integer = 0 To seferler.Length - 1

                                Dim satir As String = seferler(p).ToString

                                Dim ogeler() As String = Split(satir, ";")

                                ' Daha önce ; ile ayırdığımız değerler parçalayıp ilkgili hücrelere yazalım

                                If ogeler.Length < 3 Then Exit For

                                If z = 0 Then

                                    oSheet.Cells(p + 2, 1) = ogeler(0)

                                    oSheet.Cells(p + 2, 2) = ogeler(1)

                                    oSheet.Cells(p + 2, 3) = ogeler(2)

                                    oSheet.Cells(p + 2, 4) = ogeler(3)

                                ElseIf z = 1 Then

                                    oSheet.Cells(p + 2, 5) = ogeler(2)

                                    oSheet.Cells(p + 2, 6) = ogeler(3)

                                Else

                                    oSheet.Cells(p + 2, 7) = ogeler(2)

                                    oSheet.Cells(p + 2, 8) = ogeler(3)

                                End If

                            Next

                        End If 'Vapur bulundu/bulunamadı

                    Next 'z 0 dan 3 e kadar günler için

                    If vapurungunsayisi > 0 Then

                        With oSheet.Range("A1", "A2")

                            .Merge()

                        End With

                        With oSheet.Range("B1", "B2")

                            .Merge()

                        End With

                        With oSheet.Range("C1", "D1")

                            .Merge()

                        End With

                        With oSheet.Range("E1", "F1")

                            .Merge()

                        End With

                        With oSheet.Range("G1", "H1")

                            .Merge()

                        End With

                        With oSheet.Range("A1", "H1")

                            .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

                            .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

                        End With

                        With oSheet.Range("A2", "H253")

                            '.WrapText = True

                            '.ColumnWidth = 10

                            .Font.Size = 9

                            .EntireColumn.AutoFit()

                            .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

                            .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

                        End With

                        oSheet.Range("D1", "D90").ColumnWidth = 6

                        oSheet.Range("D1", "D90").WrapText = True

                        oSheet.Range("F1", "F90").ColumnWidth = 6

                        oSheet.Range("F1", "F90").WrapText = True

                        oSheet.Range("H1", "H90").ColumnWidth = 6

                        oSheet.Range("H1", "H90").WrapText = True

                        oSheet.Range("E3", "F" & vapurhareketsayisi).Interior.ColorIndex = 17

                        oSheet.SaveAs(path & "\Vapur\" & strkalkis & "-" & strvaris & ".xls")

                        oWB.Close()

                        oXL.Quit()

                    End If
                End If 'kalkış ile varış farklıysa
sonraki:
            Next

        Next

cikis:

        lblsondurum.Text = "Vapur Listeleme Sona Erdi" & vbCrLf & "Bazı excel uygulamaları kapanmamış olabilir elle sonlandırabilirsiniz.."

        btnvapur.Enabled = True

    End Sub
    Private Sub TextBox1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles txtpath.MouseClick

        objfolder.ShowNewFolderButton = True

bas:

        objfolder.ShowDialog()

        If objfolder.SelectedPath <> "" Then

            txtpath.Text = objfolder.SelectedPath

        End If

        If Not System.IO.Directory.Exists(txtpath.Text) Then

            MsgBox("Dosyaların kayıt edileceği klasör mevcut değil")

            GoTo bas

        End If

    End Sub
    Private Sub ProcessKill()

        Dim isleyenprocess As Integer = 0

        For Each proc As Process In Process.GetProcessesByName("Excel")

            isleyenprocess += 1

        Next proc

tekrarsonlandir:

        For y As Integer = 0 To isleyenprocess

            Dim objProcess As New Process()

            objProcess.StartInfo.UseShellExecute = False

            objProcess.StartInfo.RedirectStandardOutput = True

            objProcess.StartInfo.CreateNoWindow = True

            objProcess.StartInfo.RedirectStandardError = True

            objProcess.StartInfo.FileName() = "taskkill.exe"

            objProcess.StartInfo.Arguments() = "/im:excel.exe /f"

            objProcess.Start()

        Next

        Thread.Sleep(5000)

        isleyenprocess = 0

        For Each proc As Process In Process.GetProcessesByName("Excel")

            isleyenprocess += 1

        Next proc

        If isleyenprocess > 0 Then

            GoTo tekrarsonlandir

        End If

    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        DirectoryCheck()
        path = txtpath.Text

        Dim thbaslat As Thread

        Dim thkbaslat As New ThreadStart(AddressOf BanliyoTara)

        thbaslat = New Thread(thkbaslat)

        thbaslat.Start()
    End Sub

    Private Sub BanliyoTara()

        lblsondurum.Text = "Banliyo seferleri alınıyor..."

        System.IO.Directory.CreateDirectory(path & "\Banliyo")

        Dim kaynakkodu As String = ""

        Dim kaynak As String = ""

        Try

            Dim istek As HttpWebRequest = HttpWebRequest.Create("http://www.izban.com.tr/Sayfalar/Single.aspx?Page=33")

            Dim cevap As HttpWebResponse = istek.GetResponse

            Dim sr As IO.StreamReader = New IO.StreamReader(cevap.GetResponseStream(), Encoding.GetEncoding("windows-1254"))

            kaynak = sr.ReadToEnd()

        Catch ex As WebException

            MsgBox("Web sayfası alınırken sorun oluştu" & vbCrLf & ex.Message)

            GoTo cikis

        End Try
        If Not (InStr(kaynak, "Alsancak") > 0) Then

            'Banliyo Yok

            GoTo cikis

        End If

        Dim baslangictext As String = "
"

        Dim tablobas As Integer = InStr(kaynak, baslangictext)

        If tablobas = 0 Then

            'tablo bulunamadı

            GoTo cikis

        End If
        Dim bitistext As String = "</table></td></tr> </table>
"

        Dim tabloson As Integer = InStr(Mid(kaynak, tablobas, Len(kaynak) - tablobas), bitistext) - 36

        kaynakkodu = Mid(kaynak, tablobas + 35, tabloson)

        kaynakkodu = Replace(kaynakkodu, Chr(13), "")

        kaynakkodu = Replace(kaynakkodu, Chr(10), "")

        kaynakkodu = Replace(kaynakkodu, "  ", "")

        kaynakkodu = Replace(kaynakkodu, "	", "")

        kaynakkodu = Replace(kaynakkodu, "</tr> ", Chr(13))

        kaynakkodu = Replace(kaynakkodu, "</tr>", Chr(13))

        kaynakkodu = Replace(kaynakkodu, "
 ", "")

        kaynakkodu = Replace(kaynakkodu, "</td> ", ";")

        kaynakkodu = Replace(kaynakkodu, "</td> ", ";")

        kaynakkodu = Replace(kaynakkodu, "", "")

        kaynakkodu = Replace(kaynakkodu, "</b></div></td>  ", ";;")

        kaynakkodu = Replace(kaynakkodu, "</b></div></td> ", ";;")

        kaynakkodu = Replace(kaynakkodu, "
 ", "")

        kaynakkodu = Replace(kaynakkodu, "</b></font></td> ", ";")

        kaynakkodu = Replace(kaynakkodu, "</b></font>", "")

        ' kaynakkodu = Replace(kaynakkodu, "  ", ";;")

        'kaynakkodu = Replace(kaynakkodu, "  ", ";;")

        kaynakkodu = Replace(kaynakkodu, "</td> ", ";")

        kaynakkodu = Replace(kaynakkodu, "</td>", "")

        kaynakkodu = Replace(kaynakkodu, "</b></div>", "")

        kaynakkodu = Replace(kaynakkodu, "</b></font>", "")

        kaynakkodu = Replace(kaynakkodu, "", "")
        Dim satirlar() As String = Split(kaynakkodu, Chr(13))
        Dim oXL As Excel.Application

        Dim oWB As Excel.Workbook

        Dim oSheet As Excel.Worksheet
        oXL = CreateObject("Excel.Application")

        oXL.Visible = False
        oWB = oXL.Workbooks.Add

        oSheet = oWB.ActiveSheet

        oSheet.Range("A1", "B1").Merge()

        oSheet.Range("C1", "D1").Merge()

        oSheet.Range("E1", "F1").Merge()

        oSheet.Cells(1, 1) = "Hafta İçi"

        oSheet.Cells(1, 3) = "Cumartesi"

        oSheet.Cells(1, 5) = "Pazar"

        For i As Integer = 1 To satirlar.Length - 1

            Dim ogeler() As String = Split(satirlar(i), ";")

            If ogeler.Length > 4 Then

                oSheet.Cells(i + 1, 1) = Trim(ogeler(0))

                oSheet.Cells(i + 1, 2) = Trim(ogeler(1))

                oSheet.Cells(i + 1, 3) = Trim(ogeler(2))

                oSheet.Cells(i + 1, 4) = Trim(ogeler(3))

                oSheet.Cells(i + 1, 5) = Trim(ogeler(4))

                oSheet.Cells(i + 1, 6) = Trim(ogeler(5))

            End If
        Next

        With oSheet.Range("A1", "F253")

            .WrapText = True

            .ColumnWidth = 12

            .Font.Size = 9

            .EntireColumn.AutoFit()

            .HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter

            .VerticalAlignment = Excel.XlVAlign.xlVAlignCenter

        End With

        If System.IO.File.Exists(path & "\Metro\Seferler.xls") Then

            Dim cvp = MessageBox.Show("Banliyo seferleri daha önce kayıt edilmiş?" & vbCrLf & "Dosyaadı:" + path & "\Banliyo\Seferler.xls", "Dosya Mevcut", MessageBoxButtons.YesNo, MessageBoxIcon.Information, MessageBoxDefaultButton.Button1)

            If cvp = vbYes Then

silveuzerineyaz:

                'Dosya mevcutsa eski dosyayı silelim

                Try

                    System.IO.File.Delete(path & "\Metro\Seferler.xls")

                Catch ex As IOException

                    MsgBox("Dosya üzerine yazılırken hata oluştu" & vbCrLf & ex.Message)

                    lblsondurum.Text = "Metro seferleri yazılamadı"

                    oWB.Close()

                    oXL.Quit()

                    Exit Sub

                End Try

            End If

        End If

        oWB.SaveAs(path & "\Metro\Seferler.xls")

        oWB.Close()

        oXL.Quit()
cikis:

        lblsondurum.Text = "Metro seferleri alımı tamamlandı..."

    End Sub
    Private Sub DirectoryCheck()

bas:

        If Not System.IO.Directory.Exists(txtpath.Text) Then

            MsgBox("Dosyaların kayıt edileceği klasöre erişilemiyor")

            objfolder.ShowDialog()

            txtpath.Text = objfolder.SelectedPath

            GoTo bas

        End If

    End Sub
End Class
 
Programın tam proje dosyasını indirmek için tıklayınız (vs 2005)



vb.net ile registry kullanarak Monitör Bilgilerini Görüntülemek
Mustafa — Sat, 26 Jun 2010 17:21:18 +0000
Envanter yazılımına bir bölüm daha ekledim. Bilgisayara bağlı olan Monitörün registry üzerinde kayıtlı olan EDID (Extended display identification data) bilgilerinden yararlanarak Serino,model,üretim tarihi,ölçüleri ve kaç inç olduğu gibi bilgilere erişebiliyoruz. Detaylı bilgi için VESA E-EDID™ Implementation Guide ı kullanabilirsiniz.
Imports System.Management

Imports System.Text

Imports Microsoft.Win32

Imports System.Net.NetworkInformation

Public Class Form1

Dim strmodel As String = “”

Dim strmodel2 As String = “”

Dim strserino As String = “”

Dim regedithex As String = “”

Dim struretimhaftasi As String = “”

Dim struretimyili As String = “”

Dim strdikey, stryatay As Integer

Dim strmonitorinc As Double

Private Function ByteArrayToString(ByVal ba As Byte()) As String

Dim hex As New StringBuilder(ba.Length * 2)

For Each b As Byte In ba

hex.AppendFormat(“{0:x2}”, b)

Next

Return hex.ToString()

End Function



Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

strmodel = “”

strmodel2 = “”

strserino = “”

regedithex = “”

Dim host As String = InputBox(“Lütfen Mönitörünü tespit etmek istediğiniz host adını veya ip adresini giriniz:”, “Bilgisayar Girişi”)

‘Eğer giriş boş geçilirse local bilgisayarı alalım

If host = “” Then host = “.”

If host <> “.” Then

Dim pingat As New Ping

Dim pingsonuc As PingReply

Try

pingsonuc = pingat.Send(host)

Catch ex As Exception

MsgBox(“Yazdığınız bilgisayar ile iletişim kurulamıyor” & ex.Message)

Exit Sub

End Try
If pingsonuc.Status <> IPStatus.Success Then

MsgBox(“Yazdığınız bilgisayar ile iletişim kurulamıyor”)

Exit Sub

End If

End If
Dim MyReg As RegistryKey = RegistryKey.OpenRemoteBaseKey(Microsoft.Win32.RegistryHive.LocalMachine, host)

Dim Key As RegistryKey = MyReg.OpenSubKey _

(“SYSTEM\CurrentControlSet\Enum\DISPLAY”, False)

‘Display parametresinin altındaki tüm keyleri subkeynames dizisine atıyoruz

Dim SubKeyNames() As String = Key.GetSubKeyNames()

Dim Index As Integer

Dim Subkey As RegistryKey

Dim dogrupath As String = “”

For Index = 0 To Key.SubKeyCount – 1

Try

‘Enum\Display keyi altındaki tüm anahtarlar için yeni bir subkey oluşturalım

Dim Key2 As RegistryKey = MyReg.OpenSubKey(“SYSTEM\CurrentControlSet\Enum\DISPLAY\” _

+ SubKeyNames(Index), False)

Dim SubKeyNames2() As String = Key2.GetSubKeyNames()
For index2 As Integer = 0 To Key2.SubKeyCount – 1

‘Birden fazla monitör takmışsanız eğer çok fazla subkey oluşabilir

‘Aktif olan monitör için subkey altında Control isimli bir anahtar bulunmakta
Subkey = MyReg.OpenSubKey(“SYSTEM\CurrentControlSet\Enum\DISPLAY\” _

+ SubKeyNames(Index) + “\” + SubKeyNames2(index2) + “\Control”, False)

‘Eğer control isimli subkey yok ise bir sonraki keye gidelim

If Subkey Is Nothing Then

GoTo sonraki

Else

‘Eğer control mevcut ise Device Parameters altındaki EDID Reg_Binary değerine bakıyoruz

‘Monitör çıkartılmış ise BAD_EDID anahtarı oluşuyor.
Subkey = MyReg.OpenSubKey(“SYSTEM\CurrentControlSet\Enum\DISPLAY\” _

+ SubKeyNames(Index) + “\” + SubKeyNames2(index2) + “\Device Parameters”, False)

Dim bytes As Byte() = Subkey.GetValue(“EDID”, Nothing)

Try

If bytes.Length > 0 Then

‘Byte olarak aldığımız değerleri hex formatına çevirelim
regedithex = ByteArrayToString(bytes)

‘MsgBox(regedithex)

struretimhaftasi = System.Convert.ToInt32(Mid(regedithex, 33, 2), 16)

struretimyili = CInt(System.Convert.ToInt32(Mid(regedithex, 35, 2), 16)) + 1990
strdikey = CInt(System.Convert.ToInt32(Mid(regedithex, 43, 2), 16))

stryatay = CInt(System.Convert.ToInt32(Mid(regedithex, 45, 2), 16))
strmonitorinc = (Math.Sqrt(strdikey * strdikey + stryatay * stryatay) / 2.54)
Subkey = MyReg.OpenSubKey(“SYSTEM\CurrentControlSet\Enum\DISPLAY\” _

+ SubKeyNames(Index) + “\” + SubKeyNames2(index2), False)

‘Eğer monitorun windows sürücüsü yüklenmiş ise modelini registry üzerinden alalım

strmodel2 = Subkey.GetValue(“DeviceDesc”)

End If
Catch ex As Exception

End Try

End If

sonraki:

Next

Catch ex As Exception
End Try

Next
’000000ff den sonraki 14 karakter seri numarayı içermekte

Dim serinoindex As Integer = InStr(regedithex, “000000ff”) + 8

’000000fc den sonra olan 14 karakter model numarasını içeriyor

Dim modelindex As Integer = InStr(regedithex, “000000fc”) + 8

Dim serinohex As String = Mid(regedithex, serinoindex, 28)

Dim modelhex As String = Mid(regedithex, modelindex, 28)
For y As Integer = 1 To Len(serinohex) Step 2

Dim s As String

Dim b As Byte

b = System.Convert.ToByte((Mid(serinohex, y, 2)), 16)

s = Chr(b)

If Asc(s) <> 0 And (Asc(s) > 47 And Asc(s) < 126) Then

strserino += s

End If

Next y

For y As Integer = 1 To Len(modelhex) Step 2

Dim s As String

Dim b As Byte

b = System.Convert.ToByte((Mid(modelhex, y, 2)), 16)

s = Chr(b)

If Asc(s) <> 0 And (Asc(s) > 47 And Asc(s) < 126) Then

strmodel += s

End If

Next y

Dim alinanhost As String = “”

If host = “.” Then

alinanhost = “Yerel bilgisayar”

Else

alinanhost = host

End If
MsgBox(“Monitör Bilgileri Alınan Bilgisayar: ” + alinanhost + vbCrLf + _

“Monitor Registry Modeli: ” & strmodel2 & vbCrLf & _

“Monitör Device Modeli: ” & Trim(strmodel) & vbCrLf & _

“Monitör Seri Numarası: ” & strserino & vbCrLf & _

“Üretim Haftası: ” & struretimhaftasi & vbCrLf & _

“Üretim Yılı: ” & struretimyili & vbCrLf & _

“Monitör Dikey Boyutu (cm): ” & strdikey & vbCrLf & _

“Monitör Yatay Boyutu (cm): ” & stryatay & vbCrLf & _

“Monitör Boyutu (inc): ” & Format(strmonitorinc, “##.##”))

End Sub

End Class
Vs2005 Örnek Uygulamasını İndirmek için tıklayınız.



vb.net üzerinde telnet uygulaması
Mustafa — Sat, 29 May 2010 15:18:12 +0000
Ağ üzerinde gün içerisinde networke dahil olmuş bilgisayarların hangi switchler üzerinden sisteme dahil olduklarını bulmak için yazdığım bir uygulama.
Uygulamanın çalışma mantığı:

Çalıştırıldığı dizinde 2 adet dosyaya ihtiyaç duyuyor ayarlar.ini ve switchler.txt. Switchler.txt switchlerin ip leri yer almakta. ayarlar.ini dosyasında ise switchlerin şifreleri (hepsi ortak olmalı), Çalıştırılacak komut (sh mac-address-table), database bilgileri ve filtreleme, loglama yapılacak mı gibi bilgiler girilmeli.
Loglama yapılacak seçilirse çalıştırıldığı dizinde Log klasörünün içerisine switchlerin konsollarından gelen verileri ve filtreleme sonucu oluşan dosyaların çıktıları yer almakta.
Filtreleme mantığı ise her switch uplink ve downlinkleri üzerinden bir çok kendi üzerinde olmayan mac adresinin database üzerine kayıt edilmesini engellemek için gerekli olan kısım. Benim örneğimde Fa (Fast Ethernet) ve Lo (Long Reach Ethernet) portlarındaki mac adreslerini almak için filtre girilmiş durumda.  En fazla 3 adet filtre için geliştirdim.
Program kısaca Cisco switchlere telnet bağlanıp Fa,Lo portlarındaki bilgilerin alınıp veritabanına kayıt edilmesini sağlıyor. İsterseniz zamanlamayı açıp her 120 saniyede bir tekrar liste almasını ve değişenleri yazmasını sağlayabilirsiniz.
SQL için aşağıdaki alanlara ihtiyaç duyulmakta;
DROP TABLE IF EXISTS `mac`;

CREATE TABLE `mac` (

`id` int(11) NOT NULL AUTO_INCREMENT,

`switch` text,

`mac` text,

`vlanid` text,

`tarama` datetime DEFAULT NULL,

`port` text,

PRIMARY KEY (`id`)

) ENGINE=InnoDB AUTO_INCREMENT=507 DEFAULT CHARSET=utf8;
VB.Net Telnet Uygulaması (vs2005)




Ücretsiz CD-DVD kayıt programı
Mustafa — Tue, 11 May 2010 06:43:53 +0000
XP Sp2,Vista SP ve W7 desteği olan ücretsiz iso kayıt programı.

http://isorecorder.alexfeinman.com/isorecorder.htm
Kuruluma ihtiyaç duymayan

Data,Audio,Video CD/DVD desteği olan

http://www.amok.am/en/freeware/amok_cd-dvd_burning/download/

Bir başka yazılım
Güncelleme: Normal kullanıcıların tüm işini görebilecek Neronun ücretsiz versiyonunu da var.

Nero Lite http://www.nero.com/eng/downloads-nbl-free.php



Symantec Live Update Administrator (LUA) servis sorunu
Mustafa — Sun, 25 Apr 2010 15:58:38 +0000
Dün Symantec version geçişinden sonra LUA servisinin durduğunu farkettim. Başta güncellemeden olduğunu sansamda sonradan java kaynaklı olduğunu buldum. 
Eğer Symantec LUA servisini başlatırken aşağıdaki hatayı alıyorsanız
Could not start the LUA Apache Tomcat service on Local Computer.

Error 1067: The process terminated unexpectedly.
ve komut istemi üzerinden 
java -version    komutunu çalıştırdığınızda

Error occurred during initialization of VM

java/lang/NoClassDefFoundError: java/lang/Object
hatasını alıyorsanız, Javanın en son kurulu paketini sisteminizden kaldırmanız veya tüm paketleri kaldırıp javayı yeniden kurmanız gerekiyor.