Anasayfa Programlama / Kodlar İndir / Download Makale / Yazı Resim / Fotoğraf
E-Learning / Video Matematik Hakkımda Bilgi Ziyaretçi Defteri

HİPER ÇARPIŞTIRICI KODLARI - HYPER MULTIPLIER CODES

VERSION 5.00
Begin VB.Form ana
BorderStyle = 3 'Fixed Dialog
Caption = "Hiper Carpistirici - alieskici.com"
ClientHeight = 4890
ClientLeft = 45
ClientTop = 330
ClientWidth = 6930
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "ana.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4890
ScaleWidth = 6930
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmd_english
Caption = "&English"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 162
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5820
TabIndex = 11
Top = 3900
Width = 1035
End
Begin VB.CommandButton cmd_yar
Caption = "Ya&rdim"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 162
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4740
TabIndex = 6
Top = 3900
Width = 1035
End
Begin VB.CommandButton cmd_u
Caption = "&Us al"
Height = 495
Left = 4740
TabIndex = 10
Top = 600
Width = 2115
End
Begin VB.TextBox tb
Appearance = 0 'Flat
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 162
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1545
Left = 4740
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 2280
Width = 2115
End
Begin VB.CommandButton cmd_kapat
Caption = "&Kapat"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 162
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5820
TabIndex = 8
Top = 4380
Width = 1035
End
Begin VB.CommandButton cmd_hak
Caption = "H&akkinda"
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 162
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4740
TabIndex = 7
Top = 4380
Width = 1035
End
Begin VB.CommandButton cmd_yeni
Caption = "&Yeni"
Height = 495
Left = 4740
TabIndex = 5
Top = 1680
Width = 2115
End
Begin VB.CommandButton cmd_dur
Caption = "&Dur"
Height = 495
Left = 4740
TabIndex = 4
Top = 1140
Width = 2115
End
Begin VB.TextBox tsonuc
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2535
Left = 60
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 2280
Width = 4575
End
Begin VB.CommandButton cmd_carp
Caption = "&Carp"
Height = 495
Left = 4740
TabIndex = 2
Top = 60
Width = 2115
End
Begin VB.TextBox t2
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1035
Left = 60
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 1140
Width = 4575
End
Begin VB.TextBox t1
BeginProperty Font
Name = "Arial"
Size = 12
Charset = 162
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1035
Left = 60
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 60
Width = 4575
End
End
Attribute VB_Name = "ana"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' HYPER MULTIPLIER
' created by ALi ESKiCi

' 2003 - Istanbul, Turkey
' to reach to Ali Eskici you can visit him site at:
' alieskici.com
' or if this site moved then type "Ali Eskici" for search enginees.

' Hyper Multiplier can multiply large numbers with each order and take exponents of any number.
' HM's architecture is able to change for more massive processes.
' Actuall, I wrote it to be a kernel processor programme for my other programme;
' Prime Number Searcher. So, PNS can find large number's factors! I think this will bring the end of RSA and DES cryptos :)

' If you read this you must be an academician. Because, i am giving this codes only to academicians.
' Please use this for humanity as like me :)

Option Explicit

Dim s1, s2 As String
Dim ts As String 'ts: 000... olarak alinan sayi
Dim elde As Byte
Dim arat As String 'ara toplam
Dim icc As Byte 'ic carpim
Dim ict As Byte 'ic toplam
Dim i, j, k As Integer
'al i es ki ci.c om
Dim sure As Single
Dim kere As Integer 'ustel icin
Dim bs As Integer
Dim islemdur As Boolean
Dim ssay1, ssay2 As Integer 'sifirsay
Public eng, hakg As Boolean

Sub ayikla()
Dim at As String
at = Chr(13) & Chr(10)

If eng = False Then
tb.Text = "Sistem hazirlaniyor...."
Else
tb.Text = "System is preparing...."
End If
If eng = False Then
tb.Text = tb.Text & at & "Birinci sayi toplam karakter: " & Len(t1.Text)
tb.Text = tb.Text & at & "Ikinci sayi toplam karakter: " & Len(t2.Text)
Else
tb.Text = tb.Text & at & "Total character of first number: " & Len(t1.Text)
tb.Text = tb.Text & at & "Total character of second number: " & Len(t2.Text)
End If
DoEvents

s1 = ""
s2 = ""

Dim say1 As Byte

For i = 1 To Len(t1.Text)
For say1 = 0 To 9
If Mid(t1.Text, i, 1) = Trim(Str(say1)) Then s1 = s1 & Mid(t1.Text, i, 1)
Next
Next
t1.Text = s1

If islemdur = True Then Exit Sub

If eng = False Then
tb.Text = "Faz 1/2 tamamlandi."
Else
tb.Text = "Phase 1/2 is done."
End If
DoEvents

For i = 1 To Len(t2.Text)
For say1 = 0 To 9
If Mid(t2.Text, i, 1) = Trim(Str(say1)) Then s2 = s2 & Mid(t2.Text, i, 1)
Next
Next
t2.Text = s2

If islemdur = True Then Exit Sub
'al ies ki ci .c om
If eng = False Then
tb.Text = "Faz 2/2 tamamlandi. Isleme devam ediliyor..."
Else
tb.Text = "Phase 2/2 is done. Continuing to process..."
End If
DoEvents


'ikinci ayiklama 0 lar icin

ssay1 = 0
ssay2 = 0

For i = Len(s1) To 1 Step -1
If Mid(s1, i, 1) = "0" Then ssay1 = ssay1 + 1 Else Exit For
Next

For i = Len(s2) To 1 Step -1
If Mid(s2, i, 1) = "0" Then ssay2 = ssay2 + 1 Else Exit For
Next

If ssay1 > 0 Then s1 = Left(s1, Len(s1) - ssay1)

islemdur = False
End Sub

Private Sub cmd_carp_Click()
If Len(t1.Text) > 16383 Then
t1.Text = ""
If eng = False Then
tb.Text = "Birinci metin kutusu toplam karakter sayisi 16383'den cok olamaz!"
Else
tb.Text = "Total character number of first text box can't be more than 16383!"
End If
t1.SetFocus
Exit Sub
End If
If Len(t2.Text) > 16383 Then
t2.Text = ""
If eng = False Then
tb.Text = "Ikinci metin kutusuna girilen carpan sayi toplam karakter sayisi 16383'den cok olamaz!"
Else
tb.Text = "Total character number of second text box can't be more than 16383!"
End If
t2.SetFocus
Exit Sub
End If

ayikla

If ssay2 > 0 Then s2 = Left(s2, Len(s2) - ssay2)

carp
End Sub

Sub carp()
On Error GoTo carph

sure = Timer

tsonuc.Text = ""

ts = String(Len(s1) + Len(s2), "0")

For i = 1 To Len(s2)
arat = ""
elde = 0
For j = 1 To Len(s1)
icc = Val(Mid(s1, Len(s1) + 1 - j, 1)) * Val(Mid(s2, Len(s2) + 1 - i, 1)) + elde
If Len(Trim(Str(icc))) = 2 Then elde = Val(Left(Trim(Str(icc)), 1)) Else elde = 0
arat = Right(Trim(Str(icc)), 1) & arat ' al i es ki ci .c om
Next
arat = Trim(Str(elde)) & arat
If Left(arat, 1) = "0" Then arat = Right(arat, Len(arat) - 1)

If islemdur = True Then Exit Sub
DoEvents

elde = 0
For k = 1 To Len(arat)
ict = Val(Mid(arat, Len(arat) + 1 - k, 1)) + Val(Mid(ts, Len(ts) - k - i + 2, 1)) + elde
If Len(Trim(Str(ict))) = 2 Then elde = Val(Left(Trim(Str(ict)), 1)) Else elde = 0
ts = Left(ts, Len(ts) + 1 - i - k) & Trim(Str(Right(ict, 1))) & Right(ts, i + k - 2)
Next
If elde <> 0 Then ts = Left(ts, Len(ts) + 1 - i - k) & Trim(Str(elde)) & Right(ts, i + k - 2)

tb.Text = Str(Len(s2) - i)
' a l i es k i ci .c o m
If islemdur = True Then Exit Sub
DoEvents
Next


If Left(ts, 1) = "0" Then ts = Right(ts, Len(ts) - 1)

If ssay1 > 0 Or ssay2 > 0 Then
ts = ts & String(ssay1 + ssay2, "0")
End If

bs = Len(ts)

tsonuc.Text = ts

If eng = False Then
tb.Text = "Basamak sayisi: " & bs & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Sure: " & Abs(Timer - sure)
Else
tb.Text = "Number of round: " & bs & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Time: " & Abs(Timer - sure)
End If
islemdur = False

Exit Sub
carph:
If eng = False Then
MsgBox ("Program disi hata! Yeniden deneyin."), vbExclamation, (Caption) ' a l i eski ci .c om
Else
MsgBox ("External error! Try again."), vbExclamation, (Caption)
End If
islemdur = False
End Sub

Sub ussu()
On Error GoTo ussuh

Dim sayiussu As Single

sure = Timer

ts = String(Len(s1) * Val(s2), "0")

sayiussu = Val(s2)

tsonuc.Text = ""

s2 = s1

For kere = 1 To sayiussu - 1

ts = String(Len(s1) * sayiussu, "0")

For i = 1 To Len(s2)
arat = ""
elde = 0
For j = 1 To Len(s1)
icc = Val(Mid(s1, Len(s1) + 1 - j, 1)) * Val(Mid(s2, Len(s2) + 1 - i, 1)) + elde
If Len(Trim(Str(icc))) = 2 Then elde = Val(Left(Trim(Str(icc)), 1)) Else elde = 0
arat = Right(Trim(Str(icc)), 1) & arat
' a l i e s ki c i .c om
Next
arat = Trim(Str(elde)) & arat
If Left(arat, 1) = "0" Then arat = Right(arat, Len(arat) - 1)

If islemdur = True Then Exit Sub
DoEvents

elde = 0
For k = 1 To Len(arat)
ict = Val(Mid(arat, Len(arat) + 1 - k, 1)) + Val(Mid(ts, Len(ts) - k - i + 2, 1)) + elde
If Len(Trim(Str(ict))) = 2 Then elde = Val(Left(Trim(Str(ict)), 1)) Else elde = 0
ts = Left(ts, Len(ts) + 1 - i - k) & Trim(Str(Right(ict, 1))) & Right(ts, i + k - 2)' a l i e s ki ci .c om
Next
If elde <> 0 Then ts = Left(ts, Len(ts) + 1 - i - k) & Trim(Str(elde)) & Right(ts, i + k - 2)

If islemdur = True Then Exit Sub
DoEvents

Next

For i = 1 To Len(ts)
If Mid(ts, i, 1) <> 0 Then
s1 = Right(ts, Len(ts) - i + 1)
Exit For
End If
Next

tb.Text = Str(sayiussu - kere - 1)

Next

ts = s1

If Left(ts, 1) = "0" Then ts = Right(ts, Len(ts) - 1)

If ssay1 > 0 Then
ts = ts + String(ssay1 * sayiussu, "0")
End If

bs = Len(ts)

tsonuc.Text = ts
If eng = False Then
tb.Text = "Basamak sayisi: " & bs & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Sure: " & Abs(Timer - sure)
Else
tb.Text = "Number of round: " & bs & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Time: " & Abs(Timer - sure)
End If

islemdur = False
Exit Sub
ussuh:
If eng = False Then
MsgBox ("Program disi hata! Yeniden deneyin."), vbExclamation, (Caption)
Else
MsgBox ("External error! Try again."), vbExclamation, (Caption)
End If
islemdur = False
End Sub

Private Sub cmd_dur_Click()
islemdur = True
If eng = False Then
tb.Text = "Islem durduruldu."
Else
tb.Text = "Process stopped."
End If
End Sub

Private Sub cmd_english_Click()
eng = Not eng

If eng = True Then
cmd_carp.Caption = "&Multiply"
cmd_u.Caption = "&Exponent"
cmd_dur.Caption = "&Stop"
cmd_yeni.Caption = "&New"
cmd_yar.Caption = "&Help"
cmd_hak.Caption = "&About"
cmd_kapat.Caption = "E&xit"
Caption = "Hyper Multiplier - alieskici.com"
cmd_english.Caption = "&Turkce"
Else
cmd_carp.Caption = "&Carp"
cmd_u.Caption = "&Us al"
cmd_dur.Caption = "&Dur"
cmd_yeni.Caption = "&Yeni"
cmd_yar.Caption = "Ya&rdim"
cmd_hak.Caption = "H&akkinda"
cmd_kapat.Caption = "&Kapat"
Caption = "Hiper Carpistirici - alieskici.com"
cmd_english.Caption = "&English"
End If

If InStr(1, tb.Text, "Ustteki") > 0 Or InStr(1, tb.Text, "Input") > 0 Then cmd_yar_Click
If hakg = True Then hak.Form_Load
End Sub

Private Sub cmd_hak_Click()
hak.Show
hakg = True
End Sub

Private Sub cmd_kapat_Click()
islemdur = True
End
End Sub

Private Sub cmd_u_Click()
On Error GoTo uhata
ayikla

If Len(t1.Text) * Val(t2.Text) > 16383 Then
If eng = False Then
tb.Text = "Cok buyuk sayi ve us girildi. Islem sistemi kilitleyecek olcude uzun sureceginden degerler iptal edildi."
Else
tb.Text = "Too big number and exponent entered. Values cancelled because of process time will be long so it will locked the system."
End If
End If

If Len(t2.Text) > 3 Then
t2.Text = ""
If eng = False Then
tb.Text = "Ikinci metin kutusuna girilen us sayi 999'dan buyuk olamaz!"
Else
tb.Text = "The number that entered to second text box can't be more than 999!"
End If
t2.SetFocus
Exit Sub
End If

If ssay1 > 0 And s1 = "1" Then
tsonuc.Text = "1" & String(ssay1 * Val(t2.Text), "0")
Exit Sub
End If

ussu

Exit Sub
uhata:
If eng = False Then
tb.Text = "Asiri buyuk degerler girildi. Islem iptal edildi." & Chr(13) & Chr(10) & "Us icin 999 ve daha kucuk degerde tam sayilar girin."
Else
tb.Text = "Extreme values entered. Process cancelled." & Chr(13) & Chr(10) & "For exponent enter 999 and less values."
End If
End Sub

Private Sub cmd_yar_Click()
If eng = False Then
MsgBox ("Ustteki metin kutusuna carpilan ya da ussu alinacak sayi, alttaki metin kutusuna da carpilan ikinci sayi veya us yazilir. Carpma islemi icin metin kutularina en fazla 16.383'er karakterlik sayilar girilebilir. Us icinse hesaplama zamaninin cok uzayabilmesi nedeniyle 999'dan buyuk uslere izin verilmez. Sayilari girerken rakamlar disinda; isaret belirteci [-/+], ayraclar, sembol, harf veya virgul karakter kullanilmamali. Rakamlar disinda karakterler girildiginde bunlar cikarilarak islem yapilacaktir. Bazen sonuc sadece 0'lardan olusursa Carp tusuna tekrar basiniz."), vbInformation, ("Hiper Carpistirici")
Else
MsgBox ("Input to above the text box the multiplicand or the number that will take its exponent, below the text box second multiplicand or the number that is the exponent. For multiply process maximum 16,383 rounded numbers may enter. For exponent no allow to the numbers more than 999 because of processing time may will be much. While entering the numbers except the figures; sign of symbol [-/+], parenthesis, symbol, letter or comma character mustn't to use. Except the figures when the characters entered process will do after these are put out. Sometimes if the result became to only 0 push to Multiply button again."), vbInformation, ("Hyper Multiplier")
End If' a l i es ki ci .c om
End Sub

Private Sub cmd_yeni_Click()
cmd_dur_Click
t1.Text = ""
t2.Text = ""
tsonuc.Text = ""
tb.Text = ""
t1.SetFocus
End Sub

Private Sub Form_Load()
islemdur = False
eng = False
hakg = False
End Sub

Private Sub t1_Change()
If eng = False Then
tb.Text = "Birinci metin kutusu toplam karakter sayisi: " & Len(t1.Text)
Else
tb.Text = "Total character number of first text box: " & Len(t1.Text) ' a l i es ki ci .c om
End If
t1.ToolTipText = Len(t1.Text)
End Sub

Private Sub t2_Change()
If eng = False Then
tb.Text = "Ikinci metin kutusu toplam karakter sayisi: " & Len(t2.Text)
Else
tb.Text = "Total character number of second text box: " & Len(t2.Text)
End If
t2.ToolTipText = Len(t2.Text)
End Sub

Private Sub tsonuc_Change()
tsonuc.ToolTipText = Len(tsonuc.Text)
End Sub

Ali Eskici Web Sitesi 2008