[程序原创]大整数的除法

ysr

程序代码如下：（仅发可调用程序）

Public Function MCC4(D1 As String, D2 As String) As String ';大整数的除法
Dim ss
ss = MBJC(D1, D2)
If ss = -1 Then
MCC4 = "0" & "/" & D1
  Else
  If ss = 0 Then
   MCC4 = 1
   Else
   If Len(D1) = Len(D2) Then
Do While MBJC(D1, D2) >= 0
S1 = S1 + 1
D1 = MPC(D1, D2)
Loop
If D1 = 0 Then
MCC4 = S1
Else
    MCC4 = S1 & "/" & D1
End If
    Else
    If Len(D2) < 9 Then
     MCC4 = MCC(D1, D2)
     Else
    Dim X, Y ';定义分段长度
   
    X = Len(D1) \ 4: Y = Len(D2) \ 4
    If Len(D1) > 4 * X Then
    X = X + 1
    D1 = String(4 * X - Len(D1), "0") & D1
    ElseIf Len(D2) > 4 * Y Then
    Y = Y + 1
    D2 = String(4 * Y - Len(D2), "0") & D2
    Else
    D1 = String(4 * X - Len(D1), "0") & D1
    D2 = String(4 * Y - Len(D2), "0") & D2
    End If
  X = Len(D1) \ 4: Y = Len(D2) \ 4
Dim JW, jcc, jss, jcs

  Dim A() As String, B() As String
  
  ReDim A(1 To X)
  ReDim B(1 To Y)
  For I = 1 To X
  A(I) = Mid(D1, I * 4 - 3, 4)
  Next
  For J = 1 To Y
  B(J) = Mid(D2, J * 4 - 3, 4)
  jws = jws & A(J)
  Next
If Len(qqdl(Trim(jws))) <= Len(qqdl(D2)) Then
  jcc = Val(Left(qqdl(A(1) & A(2)), 2)) \ Val(Left(qqdl(B(1) & B(2)), 2))
  Else
  jcc = Val(Left(qqdl(A(1) & A(2)), 2 + Len(qqdl(Trim(jws))) - Len(qqdl(D2)))) \ Val(Left(qqdl(B(1) & B(2)), 2))
  End If

  jss = MbC(Trim(jcc), D2)
  
   
      Do While MBJC(Trim(jws), Trim(jss)) = -1
      jcc = jcc - 1
      jss = MbC(Trim(jcc), D2)
      Loop
  JW = MPC(Trim(jws), Trim(jss))
  
    z = X - Y
   
    Dim c() As String
    ReDim c(1 To z)
    For s = 1 To z
     If MBJC(JW & A(s + Y), D2) = -1 Then
       c(s) = "0000"
       Else
       If Len(qqdl(JW & A(s + Y))) = Len(qqdl(D2)) Then
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4)) \ Val(Left(qqdl(B(1) & B(2)), 4))
  Else
  If Len(qqdl(JW & A(s + Y))) <= Len(qqdl(D2)) Then
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4)) \ Val(Left(qqdl(B(1) & B(2)), 4))
  Else
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4 + Len(qqdl(JW & A(s + Y))) - Len(qqdl(D2)))) / Val(Left(qqdl(B(1) & B(2)), 4))
  jwc = Format(Val(jwc), "0.000000")
  If InStr(jwc, ".") = 0 Then
  jwc = jwc
  Else
  jwc = Left(jwc, InStr(jwc, ".") - 1)
  End If
  End If
  End If
     c(s) = jwc
         End If
       jsw = MbC(Trim(c(s)), Trim(D2))
       Do While MBJC(JW & A(s + Y), Trim(jsw)) = -1
      c(s) = c(s) - 1
      jsw = MbC(Trim(c(s)), D2)
      Loop
     JW = MPC(JW & A(s + Y), MbC(Val(c(s)), D2))
     Do While MBJC(Trim(JW), Trim(D2)) >= 0
     jwc1 = jwc1 + 1
     JW = MPC(Trim(JW), Trim(D2))
     Loop
     c(s) = Val(c(s) + jwc1)
    c(s) = Right(100000000 + Val(c(s)), 4)
     
    jcc = jcc & c(s)
    Next s
    If JW = 0 Then
    MCC4 = jcc
    Else
    MCC4 = jcc & "/" & JW
    End If
   
  For I = 1 To Len(MCC4)
    If Not Mid(MCC4, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(MCC4, I)
  If Len(strTmp) = 0 Then
  MCC4 = "0"
  Else
MCC4 = strTmp
End If
   
    End If
   
  End If
End If
End If
End Function

ysr

13475764446248323351679152231852990810477964523839113636292150078823893875831651489594785825000099819033758237028286105052255675258233919969000065569882086574301490999897127477469097987533376235047438267886788920256941695997130319915354000075241410863346839706467935834787454715077091299781617364904608621287942141174321604172633086525006603630929164989499751807969392864626767131247625106373736237006843308347532269000051044563197320386712286270168622583457302828765937831502792756533030797880333576231820836772319161253980477979800801683810440646913628306534167769645315964222540674659635551293624821002232218473334430999891023149765691150000667199454878091475449521958509133081218945357098534488310000776670583726833030558798508991501435356309966650560465869184743522308859904099138065539666423940619373731124929115636139688987337622376561076213853980214514907918778327811145538460955492648370659776628883000044924865739653785101301426561748218708448998185011337055553699491445394228653231099924163346513957914958402559600000721100003315891112949508625900001307912221439976591411916213707658017781931358739489171346295631154213585884400665226859686069031496504235442301116434815351936819151701612529855594596600007092258972624046684017134078874908490000402115315434323131459962720860201874079152543522845791634983093826156115123000004756408852929358379011640000726297756445172385816222081088160521317166632500575508145275875155284962295180391904000039683419103797802663169852820517943060842134571900005570962616978699397707178967835340565726652056788437768613152054117074449324274593406701348562969913057656035677716036786772234869688474457835970793358414116679774896329181311657975343110262537801797594975903362476220632151731219374298697222014583716676886000093831268594881459271474682565018617620529136371868626564885071363286247855869781833326421634400556799500181932686842739444453560833958930833677959350546633320631926607660580849655231722593841015582113000080742148695858429407717387876199550835859633246032386945764253831874137509104825606838576386441273490549000072253330505853665252000069748466000054405387677832853696262346029203000011760981255797564764306287641209100892585872919953882335135864018677762179001913395364550521568865946958955900001048951086028637917075821715587493700000810639337867614688346926851738072437813357384075391311287360148300002597112923986885956413807692125428995942500428073246527440216509000036036547439715879654551406574793386723210000570605383482507884106890858691316784815065816625743260628095307841513913499126070815529476676513000093318625268316878988746600003175253775967921883426121126873181896904248283126019368873286561841624808021189800005212277758764065743100003168386766183541000078520000920673857840961942002304921592095746783892299517494888365703512969293976851400008398480813286662930255956507122300002525500022471363854785744287672142103901297272479278624019718641097375409493862996464654259831510000131100005235171962620000795548751034151500009848000003771430118350635260743016226172800699798076965374535020419472876890834828523995934219795291449287150858143632800000877600003935220967888740666120014311866097409473883552329759175465072023552660321389985464243369140538455262111005172699189168381736264040496844246342961414344525660590948044595234927795015246432300002129768794749958760574609565139052160595817791152205192355526771147390817118221197498953645085780000804937749776989870279482315077513037463396743160660846702487463358143733451990234947000046354341482005913324287399174596502298956035868145902986071671919250285164583361651676915353397839508249297127303181218059413991601615633346228232181030907312416741161736595617344124374463126031049464721363424849904667889853127816383281629613545157709291181363797722521411332496222497318643550000263145082184350960238457612812229054860217511235744967261410781962529407000008666370000025297142144721139893150915930000155659107133066907891592431638077903000044207212453800000711473858299406818880221247345239706591176290851801071482122826790772381040904151429647434206816660097346225674973953865487054117588705739374184884696286044585222233190000041882732246552409550952805387553425603316138135153934407288370853191414064041154999821678538074273393870827000091870000622456374956872998418302322434701490304651121476271086364197735965426832265242026557698337808817212191605658386192434287432312608926301482211964222750219446666955288404217623672281000062767343465228116309691600003453365354587788899190793937718351693802352125522416056600002511658300000643578796177798232954827496069220379170244017168874794792102267599517775491648046055914687116461995793781133868274377539628628241412390863697328586748431831629738147048125410820829568543672016082429461449586243167460000240159306564820474009979799136998384536013026305739637789156599955573648514678167023689986106489/27909298用时0.6054688秒，有4889位（这个是稍有变化的程序结果，二者结果一样的，速度差别不大）

ysr

这个程序也是可以的：（仅发可调用程序）

Public Function MCC4(D1 As String, D2 As String) As String ';大整数的除法
Dim ss
ss = MBJC(D1, D2)
If ss = -1 Then
MCC4 = "0" & "/" & D1
  Else
  If ss = 0 Then
   MCC4 = 1
   Else
   If Len(D1) = Len(D2) Then
Do While MBJC(D1, D2) >= 0
S1 = S1 + 1
D1 = MPC(D1, D2)
Loop
If D1 = 0 Then
MCC4 = S1
Else
    MCC4 = S1 & "/" & D1
End If
    Else
    If Len(D2) < 9 Then
     MCC4 = MCC(D1, D2)
     Else
    Dim X, Y ';定义分段长度
   
    X = Len(D1) \ 4: Y = Len(D2) \ 4
    If Len(D1) > 4 * X Then
    X = X + 1
    D1 = String(4 * X - Len(D1), "0") & D1
    ElseIf Len(D2) > 4 * Y Then
    Y = Y + 1
    D2 = String(4 * Y - Len(D2), "0") & D2
    Else
    D1 = String(4 * X - Len(D1), "0") & D1
    D2 = String(4 * Y - Len(D2), "0") & D2
    End If
  X = Len(D1) \ 4: Y = Len(D2) \ 4
Dim JW, jcc, jss, jcs

  Dim A() As String, B() As String
  
  ReDim A(1 To X)
  ReDim B(1 To Y)
  For I = 1 To X
  A(I) = Mid(D1, I * 4 - 3, 4)
  Next
  For J = 1 To Y
  B(J) = Mid(D2, J * 4 - 3, 4)
  jws = jws & A(J)
  Next
If Len(qqdl(Trim(jws))) <= Len(qqdl(D2)) Then
  jcc = Val(Left(qqdl(A(1) & A(2)), 2)) \ Val(Left(qqdl(B(1) & B(2)), 2))
  Else
  jcc = Val(Left(qqdl(A(1) & A(2)), 2 + Len(qqdl(Trim(jws))) - Len(qqdl(D2)))) \ Val(Left(qqdl(B(1) & B(2)), 2))
  End If

  jss = MbC(Trim(jcc), D2)
  
   
      Do While MBJC(Trim(jws), Trim(jss)) = -1
      jcc = jcc - 1
      jss = MbC(Trim(jcc), D2)
      Loop
  JW = MPC(Trim(jws), Trim(jss))
  
    z = X - Y
   
    Dim c() As String
    ReDim c(1 To z)
    For s = 1 To z
     If MBJC(JW & A(s + Y), D2) = -1 Then
       c(s) = "0000"
       Else
       If Len(qqdl(JW & A(s + Y))) = Len(qqdl(D2)) Then
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4)) \ Val(Left(qqdl(B(1) & B(2)), 4))
  Else
  If Len(qqdl(JW & A(s + Y))) <= Len(qqdl(D2)) Then
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4)) \ Val(Left(qqdl(B(1) & B(2)), 4))
  Else
  jwc = Val(Left(qqdl(JW & A(s + Y)), 4 + Len(qqdl(JW & A(s + Y))) - Len(qqdl(D2)))) / Val(Left(qqdl(B(1) & B(2)), 4))
  jwc = Format(Val(jwc), "0.000000")
  If InStr(jwc, ".") = 0 Then
  jwc = jwc
  Else
  jwc = Left(jwc, InStr(jwc, ".") - 1)
  End If
  jym = Val(Left(qqdl(JW & A(s + Y)), 4 + Len(qqdl(JW & A(s + Y))) - Len(qqdl(D2)))) - Val(jwc) * Val(Left(qqdl(B(1) & B(2)), 4))
  jym1 = Val(jym & Mid(qqdl(JW & A(s + Y)), 4 + Len(qqdl(JW & A(s + Y))) - Len(qqdl(D2)) + 1, 4)) - Val(jym) * Val(Mid(qqdl(B(1) & B(2)), 5, 4))
  If jym1 >= 0 Then
  jwc = jwc
  Else
  jwc2 = Abs(jym1) \ Val(Left(qqdl(B(1) & B(2)), 4)) + 1
  jwc = (jwc + jwc2) \ 2
  End If
  End If
  End If
     c(s) = jwc
         End If
       jsw = MbC(Trim(c(s)), Trim(D2))
       Do While MBJC(JW & A(s + Y), Trim(jsw)) = -1
      c(s) = c(s) - 1
      jsw = MbC(Trim(c(s)), D2)
      Loop
     JW = MPC(JW & A(s + Y), MbC(Val(c(s)), D2))
     Do While MBJC(Trim(JW), Trim(D2)) >= 0
     jwc1 = jwc1 + 1
     JW = MPC(Trim(JW), Trim(D2))
     Loop
     c(s) = Val(c(s) + jwc1)
    c(s) = Right(100000000 + Val(c(s)), 4)
     
    jcc = jcc & c(s)
    Next s
    If JW = 0 Then
    MCC4 = jcc
    Else
    MCC4 = jcc & "/" & JW
    End If
   
  For I = 1 To Len(MCC4)
    If Not Mid(MCC4, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(MCC4, I)
  If Len(strTmp) = 0 Then
  MCC4 = "0"
  Else
MCC4 = strTmp
End If
   
    End If
   
  End If
End If
End If
End Function

ysr

2678145490787694710138406683675886762424440548647327525594133873038347266950777818028529804877891353347244255046176220880989519574806598935727647635506939520211209794328712328126947740602255036264392628020291100698432900022333877728824270241063030019536831205264726059774673235680796770108334187808344470141093691232926021244583649747591446066921535333854157441330339217364515328375889937313870826987520723914810358707312468857074455945610038118763873992681688857200178452843740327143990247797893489008808544535536081089994800692174759199578596435124153437689121057209523619989593900355037400039597165241729693472001589594642879166693443994939359639600558001937547209387175085119128575833396037478944824322315197771750730768383267287661855880237549141571520374996029107650341071074081501632143441365461865431362023790463469688071768208320226561675630348708531708110373889241713511809029065048200924851629507265095151843687852114948736130517024578482059771284515915597919026074110811882700307150650858080695566672584075215926450360584738705106755945308199980660478183563586945902705730231409948938478910176292179410952310592864745025373902249844607078729230098512959498522851990040833671698873183076996740726479481352429756295966452788332789259316653805673821716832204368483794501474641036177256005810416507649770210480747056764697918800240201155395628561684853684747063434500664449114760179367086926249813006056735202795763742271472136500817313178050955623517148960973128433455798444839070215800699075256371341531892841721456473301085595261371522078416420399702683504171019191363372883472415693921509069484448792009627325245658854979159002549542769741504596589556474585723101403486046952706847309188488390899096649210853675228464611999630360164703837131620319658277117300208326944026347808645954842782309633205645471959842390075986572806483755223497552549948718545978420793425036666212191832327909389117021539426917904222971515424022606157676379417252939026404363841301595348953340657745965591468370831371449860774296757556463049237248472613472436666799615694672489600751763956185893123579218797539971253828850163437053164723845196089466298000486042246621634263064752906475198879616484926366053597071510886820878425907736453843197228282179943365206039514850477377542684361730162273246709577442085159313947668552462343596819299335060863266863059421286080919061657175757802930378698062290163092494909661982639303946271889619023417245433500782685534406291391527022657608608130680134939380126048353657648559735671562230714451258764762350451448379438849319710473631625533527602085050858633346936315115309333355986556546113134787213610042970405680162084678021281774169131725296977361816657904233850711837826724976507876061043779177845550646612327663283839673950405472039432309339110648301347672597370034346896334064135099613033528785924976781865447506814375627647103020761819104412269362847848884053177378762432543285984193091289854949394023586451139393716370633759317698908834326333339634557238526607966375935960004339535161203546369910853171524516945554862019134684985868547068709986010719120259421723270478586992153989283736650948010894951434857207445141886625290777550599700738909777829412358941157674866550887608199469723859806486384262574182811908513849905040209776132986875560077482527819093584150609347560543627976011009349905362597935257895287412087233810106693141683912683308201407373637490835862452911394718399632093441745957478079754723679119343225931665785380948807114301164623717144211285944154289093317610519159281033583963015810556464180819928345256832572962092994993950655913067768151113345566231088759030148164710287289335782462899525700500822021472132532771242198844498579102733028256523810973405350508253183399668290339844052874956694050028526577775764032598023622192221226501334606994447870277619118208162133562541678250491647671042612088902952091163094215645902682086024337098910110924115381788866213335441814530141911754446270296630426675020592640816713810936850961517475097707179713115856513919631998747192606018612535436009162735908155778165736923393260822217415131632296810207091918499370220533980666393617256227781299273913099896641458499949922475383775878771011361417556799406151773618626138749998464514570482965286184387350245762317271666329142667987131139265167425606863654107927682419958167046956962340419295394058625063862272314570914511355913547470055072878835349142049813368019960713974852351833144227544851625677753419141348585495260230041111323576432417502998832485027071744397105338790364666312325483218209150368759120749671419554589928540715813531144241705501211397506662448276056294585639532800634727428900861538486753011006379264618338782036690340859441153926551954112364946638768223012718907190897165613382555036872673785444132692292217184974818914501886689736449912131900762592363447945036085692999163815947845753538999001633767986447907729462453017601/
198737927=
13475764446248323351679152231852990810477964523839113636292150078823893875831651489594785825042299819033758237028286105052255675258233919969023565569882086574301490999897127477469097987533376235047438267886788920256941695997130319915354004075241410863346839706467935834787454715077091299781617364904608621287942141174321604172633086525006603630929164989499751807969392864626767131247625106373736237006843308347532269003251044563197320386712286270168622583457302828765937831502792756533030797880333576231820836772319161253980477979800801683810440646913628306534167769645315964222540674659635551293624821002232218473334430999891023149765691150332667199454878091475449521958509133081218945357098534488310448776670583726833030558798508991501435356309966650560465869184743522308859904099138065539666423940619373731124929115636139688987337622376561076213853980214514907918778327811145538460955492648370659776628883047044924865739653785101301426561748218708448998185011337055553699491445394228653231099924163346513957914958402559600263721100093315891112949508625903401307912221439976591411916213707658017781931358739489171346295631154213585884400665226859686069031496504235442301116434815351936819151701612529855594596603357092258972624046684017134078874908490284402115315434323131459962720860201874079152543522845791634983093826156115123002164756408852929358379011640212726297756445172385816222081088160521317166632500575508145275875155284962295180391904012139683419103797802663169852820517943060842134571904115570962616978699397707178967835340565726652056788437768613152054117074449324274593406701348562969913057656035677716036786772234869688474457835970793358414116679774896329181311657975343110262537801797594975903362476220632151731219374298697222014583716676886029293831268594881459271474682565018617620529136371868626564885071363286247855869781833326421634400556799500181932686842739444453560833958930833677959350546633320631926607660580849655231722593841015582113027180742148695858429407717387876199550835859633246032386945764253831874137509104825606838576386441273490549008072253330505853665252027969748466029654405387677832853696262346029203001811760981255797564764306287641209100892585872919953882335135864018677762179001913395364550521568865946958955904161048951086028637917075821715587493700481810639337867614688346926851738072437813357384075391311287360148301022597112923986885956413807692125428995942500428073246527440216509018436036547439715879654551406574793386723210285570605383482507884106890858691316784815065816625743260628095307841513913499126070815529476676513038493318625268316878988746601883175253775967921883426121126873181896904248283126019368873286561841624808021189804655212277758764065743103283168386766183541033978520180920673857840961942002304921592095746783892299517494888365703512969293976851401538398480813286662930255956507122302342525500022471363854785744287672142103901297272479278624019718641097375409493862996464654259831510466131101935235171962620071795548751034151503129848005003771430118350635260743016226172800699798076965374535020419472876890834828523995934219795291449287150858143632800134877601653935220967888740666120014311866097409473883552329759175465072023552660321389985464243369140538455262111005172699189168381736264040496844246342961414344525660590948044595234927795015246432302302129768794749958760574609565139052160595817791152205192355526771147390817118221197498953645085780460804937749776989870279482315077513037463396743160660846702487463358143733451990234947003946354341482005913324287399174596502298956035868145902986071671919250285164583361651676915353397839508249297127303181218059413991601615633346228232181030907312416741161736595617344124374463126031049464721363424849904667889853127816383281629613545157709291181363797722521411332496222497318643550202263145082184350960238457612812229054860217511235744967261410781962529407003108666370012625297142144721139893150915930314155659107133066907891592431638077903035644207212453803420711473858299406818880221247345239706591176290851801071482122826790772381040904151429647434206816660097346225674973953865487054117588705739374184884696286044585222233190044041882732246552409550952805387553425603316138135153934407288370853191414064041154999821678538074273393870827021291870168622456374956872998418302322434701490304651121476271086364197735965426832265242026557698337808817212191605658386192434287432312608926301482211964222750219446666955288404217623672281034862767343465228116309691601203453365354587788899190793937718351693802352125522416056602772511658303600643578796177798232954827496069220379170244017168874794792102267599517775491648046055914687116461995793781133868274377539628628241412390863697328586748431831629738147048125410820829568543672016082429461449586243167460001240159306564820474009979799136998384536013026305739637789156599955573648514678167023689986106489/27909298用时0.4023438秒（这个是用原来的除法MCC1计算的，可见当除数很小时，原来的除法就很快，比这个改进版程序还稍快点呢）

ysr

Public Function MBBC(D1 As String) As String 'kai pingfang
If Len(D1) < 10 Then
jss = Int(Sqr(D1))
JW = Val(D1) - (jss) ^ 2
  If JW = 0 Then
  MBBC = jss
  Else
  MBBC = jss & "/" & JW
    End If
Else
Dim x 'shuju changdu
x = Len(D1) \ 4
D2 = String(4 - Len(D1) + 4 * x, "0") & D1
Dim A() As String
ReDim A(4 To 4 * x + 4)
Dim B() As String
ReDim B(2 To 2 * x)
Dim I, J, js
  For I = 4 To 4 * x + 4 Step 4
  
A(I) = Mid(D2, I - 3, 4)
js = Int(Sqr(Val(A(4) & A(8))))
JW = Val(A(4) & A(8)) - (js) ^ 2
Next
   J = 4
   Do While J <= 2 * x
   
   jws = MPC1(JW & "0000", A(2 * J + 4))
   If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then
    B(J) = "00"
    Else
    jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2)
    If Len(jwc) > 2 Then
     B(J) = 99
     Else
     B(J) = jwc
     End If
   
     
     Do While MBJC(Trim(jws), MbC(MPC1(B(J), MbC(Trim(js), 200)), B(J))) = -1
     
     B(J) = B(J) - 1
     
               Loop
          End If
          JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(J)), B(J)))
      
     js = MPC1(MbC(Trim(js), 100), Trim(B(J)))
     
      
   J = J + 2
   If JW = 0 Then
      
   MBBC = js
   Else
   MBBC = js & "/" & JW
   End If
   Loop
   
End If
End Function

Public Function MBJC(D1 As String, D2 As String) As String ';bijiao
If Len(D1) <= 10 And Len(D2) <= 10 Then
If Val(D1) > Val(D2) Then
MBJC = 1
Else
If Val(D1) = Val(D2) Then
MBJC = 0
Else
MBJC = -1
End If
End If
Else

If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) Then
Dim x, Y
x = Len(D1) \ 4: Y = Len(D2) \ 4
Dim A() As String, B() As String
ReDim A(4 To 4 * x + 4)
ReDim B(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
  MBJC = 1
  Else
  If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
  MBJC = -1
  Else
  For I = 4 To 4 * x Step 4
  A(I) = Mid(D1, Len(D1) - I + 1, 4)
  B(I) = Mid(D2, Len(D2) - I + 1, 4)
  Next
  J = 4 * x
  Do While A(J) = B(J) And J >= 8
  
  J = J - 4
     Loop
     
     
   If Val(A(J)) - Val(B(J)) > 0 Then
   MBJC = 1
   Else
   If Val(A(J)) - Val(B(J)) < 0 Then
   MBJC = -1
   Else
   MBJC = 0
   End If
   
  End If
  
  
  
End If
End If
End If
End If
End If
End If
End Function

Public Function MCC(D1 As String, D2 As String) As String ';除数少于8位的除法
If Len(D1) < Len(D2) Then
   MCC = "0" & "/" & D1
   Else
   If Len(D1) < 9 Then
    MCC = Val(D1) \ Val(D2) & "/" & Val(D1) - (Val(D1) \ Val(D2)) * Val(D2)
     If Mid(MCC, InStr(MCC, "/") + 1) = 0 Then
  MCC = Left(MCC, InStr(MCC, "/") - 1)
Else
MCC = MCC
End If
   
    Else
   
   Dim x ';fen duan changdu
   x = Len(D1)
   
     
   
     Dim A() As String
      ReDim A(1 To x)  ';定义数组的储存空间
      For I = 1 To x Step 1  ';把被除数各位放在a()中
       A(I) = Mid(D1, I, 1)
        
      
       Next I
      Dim B() As String
      JW = 0
     ReDim B(1 To x)
     For J = 1 To x Step 1
    B(J) = Val(JW & A(J)) \ Val(D2)
      JW = Val(JW & A(J)) - Val(B(J)) * Val(D2)
       Next J
       For r = 1 To x
       If JW = 0 Then
          MCC = MCC & B(r)
          Else
          CJ = CJ & B(r)
          MCC = CJ & "/" & JW
      
    End If
   
    For I = 1 To Len(MCC)
   If Not Mid(MCC, I, 1) = "0" Then
       Exit For
   End If
Next
strtmp = Mid(MCC, I)
If Len(strtmp) = 0 Then
MCC = "0"
Else
MCC = strtmp
End If
   
   Next
   
   End If
     
     End If
   
End Function

Public Function MCC4(D1 As String, D2 As String) As String ';大整数的除法
Dim ss
ss = MBJC(D1, D2)
If ss = -1 Then
MCC4 = "0" & "/" & D1
  Else
  If ss = 0 Then
   MCC4 = 1
   Else
   If Len(D1) = Len(D2) Then
     s = Val(Left(D1, 1)) \ Val(Left(D2, 1))

Do While MBJC(MbC(Trim(s), Trim(D2)), D1) = 1
  s = s - 1
  Loop
  If MBJC(MbC(Trim(s), Trim(D2)), D1) = 0 Then
   MCC4 = s
   Else
   MCC4 = s & "/" & MPC(Trim(D1), MbC(Trim(s), Trim(D2)))

End If
    Else
    If Len(D2) < 9 Then
     MCC4 = MCC(D1, D2)
     Else
    Dim x, Y ';定义分段长度
    x = Len(D1): Y = Len(D2)
   
Dim JW, jcc, jss, jcs

  Dim A() As String, B() As String
  
  ReDim A(1 To x)
  ReDim B(1 To Y)
  For I = 1 To x
  A(I) = Mid(D1, I, 1)
  Next
  For J = 1 To Y
  B(J) = Mid(D2, J, 1)
  Next
  jcc = Val(A(1) & A(2)) \ Val(B(1) & B(2))
   
      
        
  jss = MbC(Trim(jcc), D2)
   For i1 = 1 To Y
    jws = jws & A(i1)
      Next
      
      Do While MBJC(Trim(jws), Trim(jss)) = -1
      jcc = jcc - 1
      jss = MbC(Trim(jcc), D2)
      Loop
  JW = MPC(Trim(jws), Trim(jss))
  
    z = x - Y
   
    Dim c() As String
    ReDim c(1 To z)
    For s = 1 To z
     If MBJC(JW & A(s + Y), D2) = -1 Then
       c(s) = "0"
       Else
     jwc = Val(Left(JW & A(s + Y), 3)) \ Val(Left(D2, 2))
      If Len(jwc) > 1 Then
      c(s) = "9"
       Else
        c(s) = jwc
         End If
      
     Do While MBJC(JW & A(s + Y), MbC(Val(c(s)), D2)) = -1
    c(s) = Right(10000 + Val(c(s) - 1), 1)
     Loop
     End If
   
     JW = MPC(JW & A(s + Y), MbC(Val(c(s)), D2))
     
    jcc = jcc & c(s)
    Next s
    If JW = 0 Then
    MCC4 = jcc
    Else
    MCC4 = jcc & "/" & JW
    End If
   
  For I = 1 To Len(MCC4)
    If Not Mid(MCC4, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MCC4, I)
  If Len(strtmp) = 0 Then
  MCC4 = "0"
  Else
MCC4 = strtmp
End If
   
   
   
    End If
   
   
   
   
   
  
  End If
End If
End If
End Function

Public Function MCC1(D1 As String, D2 As String) As String ';大整数的除法
If Len(D1) < 500 And Len(D2) < 500 Then
MCC1 = MCC4(Trim(D1), Trim(D2))
Else
Dim A, B
  A = Trim(D1): B = Trim(D2): b3 = B: a3 = A
  If Len(B) = 1 Then
  X1 = Mid(B, 1, 1): X2 = 1 / X1 - 0.01
  Else
  X1 = Mid(B, 1, 2): X2 = 10 / X1 - 0.01
  End If
  x = Mid(X2, 1, 4)
  Y = 0: x3 = 0
  sb = Len(a3) + Len(b3) - 1 + 10
  If Len(a3) = Len(b3) And MBJC(Trim(a3), Trim(b3)) = 0 Then
  a1 = 1
  Text3 = a1
  Else
  If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) = 0 And Val(Len(qdhz0(Trim(a3)))) = Val(Len(b3)) Then
  a1 = 1 & String(Len(a3) - Len(qdhz0(Trim(a3))), "0")
  Else
  
  A = A & String(10, "0"): B = B & String(10 + Len(a3), "0")
  x = qdqd0(ydxsd(Trim(x), Val(sb)))
  Y1 = 2 & String(Val(sb), "0")
  Do While MBJC(MPC(Trim(x), Trim(x3)), 1) >= 0
  
  s3 = s3 + 1
  Y = mbc2(Trim(x), MPC(Trim(Y1), mbc2(Trim(B), Trim(x), Val(sb))), Val(sb))
  x3 = x
  x = Trim(Y)
  Loop
  a1 = mbc2(Trim(Y), Trim(A), Val(sb))
  s = Len(a3) - Len(b3)
  a1 = qdqd0(Trim(a1))
  
  If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) < 0 Then
  a1 = tjxsd(Trim(a1), Len(a1) - s)
  Else
  a1 = tjxsd(Trim(a1), Len(a1) - s - 1)
  End If
  End If
  
  If InStr(a1, ".") = 0 Then
  a1 = a1
  Else
  a1 = Left(a1, InStr(a1, ".") - 1)
  End If
  ja = MPC(Trim(a3), MbC4(Trim(b3), Trim(a1)))
  Do While MBJC(Trim(ja), Trim(b3)) >= 0
  ja = MPC(Trim(ja), Trim(b3))
  s5 = s5 + 1
  Loop
  a1 = MPC1(Trim(a1), Trim(s5))
  If ja = 0 Then
  MCC1 = a1
  Else
  MCC1 = a1 & "/" & ja
  End If
  End If
  End If
End Function
Private Function tjxsd(sa As String, sd As String) As String
  If Val(Len(sa)) > Val(sd) Then
  tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
  Else
  If Val(Len(sa)) = Val(sd) Then
    tjxsd = "0." & sa
    Else
    tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
    End If
    End If

  End Function


Public Function MbC(D1 As String, D2 As String) As String
Dim j1&, j2&, e&, d&, e1&, m, n

   ' 按列法计算C=A*B
m = Trim(D1): n = Trim(D2)
x = Len(m) \ 4: Y = Len(n) \ 4
m = String(4 * x + 4 - Len(m), "0") & m
n = String(4 * Y + 4 - Len(n), "0") & n
x = x + 1: Y = Y + 1
Dim A(), B()
ReDim A(1 To x): ReDim B(1 To Y)
For i1 = 1 To x
A(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To Y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = x: mb = Y
    MC = ma + mb
    ReDim c(MC)
    e1 = 0
    j1 = ma: j2 = ma
    For I = MC To 2 Step -1
        If I <= ma Then j2 = I - 1
        e = e1: e1 = 0
        For J = j1 To j2
            e = e + A(J) * B(I - J)
            If e > 2040000000 Then '减少进位次数
                e = e - 2040000000
                e1 = e1 + 204000
            End If
        Next J

        If j1 > 1 Then j1 = j1 - 1
base = 10000
        d = e \ base
        c(I) = e - d * base
        If Len(c(I)) < 4 Then
        c(I) = String(4 - Len(c(I)), "0") & c(I)
        Else
        c(I) = c(I)
        End If
jc = c(I) & jc
        e1 = e1 + d
    Next I
    jc = d & jc
   MbC = qdqd0(Trim(jc))
End Function



Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
  Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
  D4 = String(Len(D1) - Len(D2), "0") & D2
  D3 = D1
  Else
  D4 = D2
  D3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(D3) \ 8: Y = Len(D4) \ 8
  If Len(D3) > 8 * x Then
  D3 = String(8 * x + 8 - Len(D3), "0") & D3
  D4 = String(8 * Y + 8 - Len(D4), "0") & D4
  x = x + 1: Y = Y + 1
  Else
  x = x: Y = Y
  D3 = D3: D4 = D4
  End If
  
  Dim A() As String, B1() As String, C1() As String, e1() As String
  ReDim A(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim e1(1 To x)
  Dim I, J, C2, CJ, JW
  For J = Y To 1 Step -1 ';D2
  JW = 1 ';yu jie weichuzhi
  B1(J) = Mid(D4, J * 8 - 7, 8) ';每位数
For I = x To 1 Step -1  ';D1
     A(I) = Mid(D3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & A(I)) - Val(B1(I)) - Val(1) + Val(JW) ';计算jia
     JW = C1(I) \ 10 ^ 8
     e1(I) = C1(I) Mod 10 ^ 8
     If Len(e1(I)) < 8 Then
     e1(I) = String(8 - Len(e1(I)), "0") & e1(I)
     Else
     e1(I) = e1(I)
     End If
     
    Next
    Next
    For r = 1 To x
    MPC = MPC & e1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    For I = 1 To Len(MPC)
      If Not Mid(MPC, I, 1) = "0" Then
          Exit For
      End If
  Next
  strtmp = Mid(MPC, I)
    If Len(strtmp) = 0 Then
    MPC = "0"
    Else
  MPC = strtmp
  End If
    Next
   
   
  End Function
  Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
D3 = D1
Else
D4 = D2
D3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(D3): Y = Len(D4)
Dim A() As Integer, B1() As Integer, C1() As Integer, e1() As Integer
ReDim A(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim e1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   A(I) = Mid$(D3, I, 1) '每位数
   C1(I) = A(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   e1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & e1(r)
  Else
  jc = jc & e1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function


Private Function zzxc(sa As String, sb As String) As String
Dim A, B, c, d, r
  A = Trim(sa)
  B = Trim(sb)
  If Len(A) < 10 And Len(B) < 10 Then
  
  If Val(A) > Val(B) Then
     c = A
     d = B
  Else
     c = B
     d = A
  End If
Do Until Val(c) Mod Val(d) = 0
     r = c Mod d
     c = d
     d = r
  Loop
  
  Else
  
  If MBJC(Trim(A), Trim(B)) >= 1 Then
  c = A
  d = B
  Else
  c = B
  d = A
  End If
  Do Until zhengchuqyushu(MCC1(Trim(c), Trim(d))) = 0
  r = zhengchuqyushu(MCC1(Trim(c), Trim(d)))
  c = d
  d = r
  Loop
  End If

  
  zzxc = d
  
End Function

Private Function qniyuan(sa As String, sb As String) As String
Dim n, p, A, B, c, d, r
  n = Trim(sa)
  p = Trim(sb)
  A = 1
  B = 0
  c = 0
  d = 1
  If Len(n) < 10 And Len(p) < 10 Then
  
  If Val(n) > Val(p) Then
     m = n
     q = p
     s1 = 1
  Else
     m = p
     q = n
     s1 = 0
  End If
Do Until Val(m) Mod Val(q) = 0
    s = m \ q
     r = m Mod q
     s1 = s1 + 1
     If s1 Mod 2 = 1 Then
     A = A
     B = A * s + B
     c = c
     d = c * s + d
     Else
     B = B
     A = A + B * s
     d = d
     c = c + d * s
     End If
     m = q
     q = r
  Loop
  If Val(A + B * m) = p Then
  B = B
  A = A + B * (m - 1)
  d = d
  c = c + d * (m - 1)
  Else
  If Val(B + A * m) = p Then
  A = A
  B = B + A * m
  c = c
  d = d + c * m
  Else
  B = B
  A = A + B * (m - 1)
  d = d
  c = c + d * (m - 1)
  End If
  End If
x = (A + B) Mod p
  Y = (c + d) Mod n
  
  
  Else
  
  If MBJC(Trim(n), Trim(p)) >= 1 Then
  m = n
  q = p
  s1 = 1
  Else
  m = p
  q = n
  s1 = 0
  End If
  Do Until zhengchuqyushu(MCC1(Trim(m), Trim(q))) = 0
  s = zhengchuqy(MCC1(Trim(m), Trim(q)))
  r = zhengchuqyushu(MCC1(Trim(m), Trim(q)))
  s1 = s1 + 1
  If s1 Mod 2 = 1 Then
  A = A
  B = MPC1(MbC(Trim(A), Trim(s)), Trim(B))
  c = c
  d = MPC1(MbC(Trim(c), Trim(s)), Trim(d))
  Else
  B = B
  A = MPC1(Trim(A), MbC(Trim(B), Trim(s)))
  d = d
  c = MPC1(Trim(c), MbC(Trim(d), Trim(s)))
  End If
  
  m = q
  q = r
  Loop
  
  If MPC1(Trim(A), MbC(Trim(B), Trim(m))) = p Then
  B = B
  A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
  d = d
  c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
  Else
  If MPC1(Trim(B), MbC(Trim(A), Trim(m))) = p Then
  A = A
  B = MPC1(Trim(B), MbC(Trim(A), Trim(m)))
  c = c
  d = MPC1(Trim(d), MbC(Trim(c), Trim(m)))
  Else
  B = B
  A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
  d = d
  c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
  End If
  End If
Do While Left(A, 1) = "0"
    A = Mid(A, 2)
Loop
  
  End If
  
  qniyuan = A
End Function

Private Function qksmimo(sa As String, sb As String, sc As String) As String
Dim c, e, n, d
c = Trim(sa)
e = Trim(sb)
n = Trim(sc)
d = 1
If Len(c) < 5 And Len(e) < 5 And Len(n) < 5 Then
c = Val(c): n = Val(n)
Do While e > 0
If Right(e, 1) Mod 2 = 0 Then
c = c * c Mod n
e = e / 2

Else
d = d * c Mod n
e = e - 1
End If
Loop
Else
c = c
Do While MBJC(Trim(e), 1) >= 0
If Right(e, 1) Mod 2 = 0 Then
c = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(c)), Trim(n)))
e = zhengchuqy(MCC1(Trim(e), 2))
Else
d = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(d)), Trim(n)))
e = MPC(Trim(e), 1)
End If
Loop
End If

qksmimo = d
End Function

Private Function fenjieyinzi(sa As String) As String
Dim A, B
Dim x As String
x = sa
B1 = Sqr(Val(x)) / 2
If InStr(B1, ".") = 0 Then
B = B1
Else
B = Left(B1, InStr(B1, ".") - 1)
End If
If x = 3 Or x = 2 Then
A = True
Else
If Right(x, 1) Mod 2 = 0 Then
A = False
Else
For I = 3 To 2 * B + 1 Step 2
b2 = x / I
If InStr(b2, ".") = 0 Then
A = False
Exit For

Else: A = True

End If
Next
End If
End If
If A = True Then
fenjieyinzi = "这是个素数"
Else
fenjieyinzi = "2*2"
End If


End Function
Private Function fenjieyinzi0(sa As String) As String
Dim A, n
n = Trim(sa)
If Len(n) < 11 Then
fenjieyinzi0 = fenjieyinzi(Trim(n))
Else
n1 = MPC(Trim(n), 1)
A = 123
'a为明文
a1 = zzxc(Trim(n), Trim(A))
If Val(a1) > 1 Then
fenjieyinzi0 = a1 & "*"
Else
c = 999
'c为公约
Do While zzxc(Trim(n1), Trim(c)) > 1
c = Val(c - 1)
Loop
d = qniyuan(Trim(c), Trim(n1))
'd为逆元为私钥
a2 = qksmimo(Trim(A), Trim(c), Trim(n))
'a2为密文
a3 = qksmimo(Trim(a2), Trim(d), Trim(n))
If MBJC(Trim(a3), Trim(A)) = 0 Then
fenjieyinzi0 = "这是素数有"
Else
fenjieyinzi0 = "2*2"
End If
End If
End If


End Function


Private Function ksm2(sa As String) As String '2的快速幂程序
Dim A, B
A = Val(2): B = sa
If B = 1 Then
ksm2 = A
ElseIf B = 0 Then
ksm2 = 1
Else
a1 = A
Do While B > 1
s = Int(Log(B) / Log(2))
s1 = 0
Do While s1 < s
A = MbC(Trim(A), Trim(A))
s1 = s1 + 1
Loop
a2 = A
B = B - 2 ^ s
A = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If B = 1 Then
ksm2 = MbC(Trim(a3), Trim(a1))
Else
ksm2 = a3
End If
s3 = Len(ksm2)
ksm2 = ksm2
End If


End Function

ysr

Private Sub Command1_Click() '求由2个孪生素数对组成的4生素数组的程序
Dim A, B
A = Val(Text1)
a1 = A
q = Val(Text2)
ts = Timer
m = Sqr(q)
t = Trim(Text4)
If Right(A, 1) Mod 2 = 0 Then
A = A + 1
Else
A = A
End If
s = 0
a2 = A
Do While a2 <= m
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0 Or InStr(fenjieyinzi0(Trim(a2)), "*") > 0
a2 = a2 + 2
Loop
B1 = a2
b2 = a2 + 2
b3 = MPC1(Trim(b2), Trim(t))
b4 = MPC1(Trim(b3), 2)

C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Val(b2))
c3 = fenjieyinzi0(Trim(b3))
D1 = fenjieyinzi0(Trim(b4))

If InStr(C1, "*") = 0 And InStr(D1, "*") = 0 And InStr(C2, "*") = 0 And InStr(c3, "*") = 0 Then
s = s + 1
Print B1, b2, b3, b4
Text3 = Text3 & "/" & B1 & "/" & b2 & "/" & b3 & "/" & b4 & vbCrLf
Else
s = s
End If
a2 = a2 + 2

Loop
a2 = a2
s1 = s
Do While a2 <= q
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0 Or InStr(fenjieyinzi0(Trim(a2)), "*") > 0
a2 = a2 + 2
Loop
B1 = a2
b2 = a2 + 2
b3 = MPC1(Trim(b2), Trim(t))
b4 = MPC1(Trim(b3), 2)

C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Val(b2))
c3 = fenjieyinzi0(Trim(b3))
D1 = fenjieyinzi0(Trim(b4))

If InStr(C1, "*") = 0 And InStr(D1, "*") = 0 And InStr(C2, "*") = 0 And InStr(c3, "*") = 0 Then
s1 = s1 + 1
Print B1, b2, b3, b4
Text3 = Text3 & "/" & B1 & "/" & b2 & "/" & b3 & "/" & b4 & vbCrLf
Else
s1 = s1
End If
a2 = a2 + 2

Loop
Combo1 = a1 & "与" & q & "之间的素数打头有" & s1 & "组差为2和" & t & "和2的4生素数对: (用时" & Timer - ts & "秒）" & vbCrLf & Text3

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Combo1 = ""
Form1.Cls
End Sub


Private Function zhengchuqyushu(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqyushu = 0
Else
zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1)
End If


End Function


Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If


End Function

Private Function qdhz0(sa As String) As String
  A = sa
  Do While Right(A, 1) = "0"
  A = Left(A, Len(A) - 1)
  Loop
  If A = "" Then
  A = 0
  Else
  A = A
  End If
  qdhz0 = A
  End Function


  Private Function qdqd0(sa As String) As String
  A = sa
  Do While Left(A, 1) = "0"
  A = Mid(A, 2)
  Loop
  If A = "" Then
  A = 0
  Else
  A = A
  End If
  qdqd0 = A
  End Function
  
  Private Function ydxsd(sa As String, sd As String) As String
  If Len(sa) = 1 And Val(sa) = 0 Then
    ydxsd = 0
    Else
   
      sc = InStr(sa, ".")
      If Val(sc) = 0 Then
      ydxsd = sa & String(sd, "0")
      Else
      se = Left(sa, Val(sc) - 1)
      sf = Right(sa, Len(sa) - Val(sc))
      If Val(Len(sf)) >= Val(sd) Then
      ydxsd = se & Mid(sf, 1, sd)
        Else
        ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
        End If
        End If
        End If
        End Function
        
        Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu
  Dim ja

  If Trim(sa) = 0 Or Trim(sb) = 0 Then
  mbc2 = 0
  Else


  ja = MbC4(Trim(sa), Trim(sb))
  If Val(Len(ja)) > Val(sd) Then
  jb = Left(ja, Val(Len(ja)) - Val(sd))
  mbc2 = jb
  Else
  mbc2 = 0
  End If


  End If
End Function
Public Function MbC4(D1 As String, D2 As String) As String '快速乘法
        Dim l As Long, le As Long, le1 As Long, n As Long, r As Long, p As Long, q As Long, m As Byte
  Dim wr As Double, w1 As Double, wlr As Double, wl1 As Double, tr As Double, t1 As Double
  Dim pi As Double, t As Double, tr1 As Double
        
  If Len(D1) + Len(D2) < 4500 Then
  MbC4 = MbC(Trim(D1), Trim(D2))
  Else
Dim xr() As Double, A As String
  A = Trim(D1)
  B = Trim(D2)
  
  
  x = Len(A) \ 4: Y = Len(B) \ 4
  A = String(Val(x * 4 + 4 - Len(A)), "0") & A
  B = String(Val(Y * 4 + 4 - Len(B)), "0") & B
  x = x + 1: Y = Y + 1
  sb1 = x + Y
  sb2 = Log(sb1) / Log(2)
  If InStr(sb2, ".") = 0 Then
  sb2 = sb2
  Else
  sb2 = Int(sb2) + 1
  End If
  sb = 2 ^ sb2
  Print sb
  A = String(Val(sb) * 4 - Len(A), "0") & A
  B = String(Val(sb) * 4 - Len(B), "0") & B
  Print A
  
  
  
   ReDim x_(1 To sb): ReDim y_(1 To sb)
    For i1 = 1 To sb
    x_(i1) = Mid(A, (sb - i1 + 1) * 4 - 3, 4): y_(i1) = Mid(B, (sb - i1 + 1) * 4 - 3, 4)
    If Len(x_(i1)) < 4 Then
    x_(i1) = String(4 - Len(x_(i1)), "0") & x_(i1)
    ElseIf Len(y_(i1)) < 4 Then
    y_(i1) = String(4 - Len(y_(i1)), "0") & y_(i1)
    Else
    x_(i1) = x_(i1): y_(i1) = y_(i1)
    End If
   
      Next
    Dim I As Long, J As Long, mn As Long, lh As Long, k As Long
    '位序倒置
n = sb '求数组大小，其值必须是2的幂
lh = n / 2
    J = n / 2
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的，高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0，则检查新的次高位
J = J + k '非则若最高位是0，则置1
    s = s & x_(J + 1)
    s1 = s1 & y_(J + 1)
    Next
    A = x_(1) & x_(1 + sb / 2) & s
    B = y_(1) & y_(1 + sb / 2) & s1
  
  ReDim xr(0 To (Len(A) - 4) \ 4): ReDim yr(0 To (Len(B) - 4) \ 4): ReDim zr(0 To (Len(B) - 4) \ 4)
  If Len(A) = 4 Then
  xr(0) = A: yr(0) = B
  Else
  For i1 = 0 To (Len(A) - 4) \ 4
  xr(i1) = Mid(A, (i1 + 1) * 4 - 3, 4)
  yr(i1) = Mid(B, (i1 + 1) * 4 - 3, 4)

     Next
     End If
  
  Dim xi(): Dim yi(): Dim zi()
  n = sb '求数组大小，其值必须是2的幂
m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > n
  n = l / 2
  ReDim xi(n - 1): ReDim yi(n - 1): ReDim zi(n - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
     
      p = p + le
  Loop Until p > n - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To n - 1 '仅输出模
   zr(I) = xr(I) * yr(I) - xi(I) * yi(I): zi(I) = xr(I) * yi(I) + xi(I) * yr(I)
    zr(I) = Format(Val(zr(I)), "0.000000"): zi(I) = Format(Val(zi(I)), "0.000000")
  

      's = s & "/" & zr(I)
      's1 = s1 & "/" & zi(I)
      Next
      
       J = sb
     
       ReDim x_(1 To sb): ReDim y_(1 To sb)
     For k = 1 To J
         n1 = n1 + 1
          ReDim Preserve x_(1 To n1)
        
         x_(n1) = zr(n1 - 1): y_(n1) = zi(n1 - 1)
         x_(n1) = Format(Val(x_(n1)), "0.000000"): y_(n1) = Format(Val(y_(n1)), "0.000000")
         
       Next
   
    '位序倒置
n = sb '求数组大小，其值必须是2的幂
lh = n / 2
    J = n / 2
   
    For I = 1 To n - 2


    Debug.Print I, J
    k = lh '下面是向右进位算法
Do
    If k > J Then Exit Do '高位是1吗
J = J - k '是的，高位置0
    k = k / 2 '准备次高位的权
Loop Until k = 0 '次高位的权若非0，则检查新的次高位
J = J + k '非则若最高位是0，则置1

xr(I + 1) = x_(J + 1): yr(I + 1) = y_(J + 1)
    js = js & "/" & x_(J + 1)
    js1 = js1 & "/" & y_(J + 1)
    Next
    sx1 = "/" & x_(1) & "/" & x_(1 + sb / 2) & js
    sy1 = "/" & y_(1) & "/" & y_(1 + sb / 2) & js1
   xr(0) = x_(1): xr(1) = x_(1 + sb / 2)
   yr(0) = y_(1): yr(1) = y_(1 + sb / 2)
   
   
   ns = Len(A) \ 4: Jn = ns
  
      
  

  ReDim zr(0 To ns - 1)

  m = 0
  l = 2
  pi = 3.14159265358979
  Do
  l = l + l
  m = m + 1
  Loop Until l > ns
  ns = l / 2
  ReDim xi(ns - 1): ReDim yi(ns - 1): ReDim zi(ns - 1)

  l = 1
  Do
    le = 2 ^ l
    le1 = le / 2
    wr = 1
    wi = 0
    If l = 1 Then
    t = 0
    Else
    t = -1 * pi / le1
    End If
    w1r = Cos(t)
    w1i = -Sin(t)
    r = 0
  Do
    p = r
    Do
     q = p + le1
     
     tr = xr(q) * wr - xi(q) * wi
     ti = xr(q) * wi + xi(q) * wr
     tr1 = yr(q) * wr - yi(q) * wi
     ti1 = yr(q) * wi + yi(q) * wr
     
     
     xr(q) = xr(p) - tr
     xi(q) = xi(p) - ti
     xr(p) = xr(p) + tr
     xi(p) = xi(p) + ti
     
       yr(q) = yr(p) - tr1
      yi(q) = yi(p) - ti1
      yr(p) = yr(p) + tr1
      yi(p) = yi(p) + ti1
     xr(p) = Format(Val(xr(p)), "0.000000"): xi(p) = Format(Val(xi(p)), "0.000000")
     yr(p) = Format(Val(yr(p)), "0.000000"): yi(p) = Format(Val(yi(p)), "0.000000")
      p = p + le
  Loop Until p > ns - 1


  wr2 = wr * w1r - wi * w1i
  wi2 = wr * w1i + wi * w1r
  wr = wr2
  wi = wi2
  r = r + 1
  Loop Until r > le1 - 1
  l = l + 1
  Loop Until l > m

  For I = 0 To ns - 1 '仅输出模
zr(I) = (xr(I) - yi(I)) / n
      zr(I) = Format(Val(zr(I) + 0.5), "0.000000")
     If InStr(zr(I), ".") = 0 Then
     s121 = zr(I)
     Else
     s121 = Left(zr(I), InStr(zr(I), ".") - 1)
      End If
      s0 = "/" & s121 & s0
      zr(I) = s121
      Next
      For i1 = 1 To Val(Jn - sb1 + 1)
      zr(sb1 + i1 - 2) = 0
      Next
      
     
     
      For i1 = 0 To n - 1
      If zr(i1) < 0 Then
      zr(i1) = "0000"
      ElseIf Len(zr(i1)) < 4 Then
      zr(i1) = String(4 - Len(zr(i1)), "0") & zr(i1)
      Else
      zr(i1) = zr(i1)
      End If
      
      s5 = s5 & "/" & zr(i1)
      
      If i1 = 0 Then
      
      s6 = Val(Left(zr(i1), Len(zr(i1)) - 4))
      If Len(s6) < 4 Then
      s6 = String(4 - Len(s6), "0") & s6
      Else
      s6 = s6
      End If
      s8 = Right(zr(i1), 4)
      ElseIf Val(zr(i1)) >= 0 Then
      s7 = MPC1(Trim(zr(i1)), Trim(s6))
      s10 = Right(s7, 4)
      s11 = s10 & s11
      If Len(s7) < 4 Then
      s7 = String(4 - Len(s7), "0") & s7
      ElseIf Len(s7) = 4 Then
      s6 = "0000"
      Else
      s7 = s7
      s6 = Val(Left(s7, Len(s7) - 4))
      End If
      Else
      s6 = s6
      End If
     
      Next
      s9 = s6 & s11 & s8
     
   
   s9 = qdqd0(Trim(s9))
   
      
      
     's2 = nifft(dxcx1(Trim(s)), dxcx1(Trim(s1)), Trim(sb1))
     
     's3 = nifft(Trim(sx1), Trim(sy1), Trim(sb1))
      MbC4 = s9
      End If
  End Function

ysr

Private Sub Command1_Click() '求梅森素数的程序
Dim A, B
A = Trim(Text1)
ts = Timer
B = 2 * Val(A) + 1
Text2 = B
c = ksm2(Trim(A)): C1 = MPC(Trim(c), 1)
C2 = MCC1(Trim(C1), Trim(B))
If InStr(C2, "/") = 0 Then
Text3 = "余数为0，这是合数。  有" & Len(C1) & "位，用时" & Timer - ts & "秒"
Else
Text3 = "余数不为0，这可能是素数！！！   有" & Len(C1) & "位，用时" & Timer - ts & "秒"
End If
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""

Form1.Cls
End Sub

Private Function ksm2(sa As String) As String '2的快速幂程序
Dim A, B
A = Val(2): B = sa
If B = 1 Then
ksm2 = A
ElseIf B = 0 Then
ksm2 = 1
Else
a1 = A
Do While B > 1
s = Int(Log(B) / Log(2))
s1 = 0
Do While s1 < s
A = MbC(Trim(A), Trim(A))
s1 = s1 + 1
Loop
a2 = A
B = B - 2 ^ s
A = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If B = 1 Then
ksm2 = MbC(Trim(a3), Trim(a1))
Else
ksm2 = a3
End If
s3 = Len(ksm2)
ksm2 = ksm2
End If


End Function

Private Function zhengchuqyushu(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqyushu = 0
Else
zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1)
End If


End Function


Private Function zhengchuqy(sa As String) As String
If InStr(sa, "/") = 0 Then
zhengchuqy = sa
Else
zhengchuqy = Left(sa, InStr(sa, "/") - 1)
End If


End Function

Private Function qdhz0(sa As String) As String
  A = sa
  Do While Right(A, 1) = "0"
  A = Left(A, Len(A) - 1)
  Loop
  If A = "" Then
  A = 0
  Else
  A = A
  End If
  qdhz0 = A
  End Function


  Private Function qdqd0(sa As String) As String
  A = sa
  Do While Left(A, 1) = "0"
  A = Mid(A, 2)
  Loop
  If A = "" Then
  A = 0
  Else
  A = A
  End If
  qdqd0 = A
  End Function
  
  Private Function ydxsd(sa As String, sd As String) As String
  If Len(sa) = 1 And Val(sa) = 0 Then
    ydxsd = 0
    Else
   
      sc = InStr(sa, ".")
      If Val(sc) = 0 Then
      ydxsd = sa & String(sd, "0")
      Else
      se = Left(sa, Val(sc) - 1)
      sf = Right(sa, Len(sa) - Val(sc))
      If Val(Len(sf)) >= Val(sd) Then
      ydxsd = se & Mid(sf, 1, sd)
        Else
        ydxsd = se & sf & String(Val(sd) - Len(sf), "0")
        End If
        End If
        End If
        End Function
        
        Private Function mbc2(sa As String, sb As String, sd As String) As String 'chengfa jingdu
  Dim ja

  If Trim(sa) = 0 Or Trim(sb) = 0 Then
  mbc2 = 0
  Else


  ja = MbC4(Trim(sa), Trim(sb))
  If Val(Len(ja)) > Val(sd) Then
  jb = Left(ja, Val(Len(ja)) - Val(sd))
  mbc2 = jb
  Else
  mbc2 = 0
  End If


  End If
End Function
Public Function MbC4(D1 As String, D2 As String) As String '快速乘法
        Dim j1&, j2&, e&, d&, e1&, m, n

   ' 按列法计算C=A*B
m = Trim(D1): n = Trim(D2)
x = Len(m) \ 4: Y = Len(n) \ 4
m = String(4 * x + 4 - Len(m), "0") & m
n = String(4 * Y + 4 - Len(n), "0") & n
x = x + 1: Y = Y + 1
Dim A(), B()
ReDim A(1 To x): ReDim B(1 To Y)
For i1 = 1 To x
A(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To Y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = x: mb = Y
    MC = ma + mb
    ReDim c(MC)
    e1 = 0
    j1 = ma: j2 = ma
    For I = MC To 2 Step -1
        If I <= ma Then j2 = I - 1
        e = e1: e1 = 0
        For J = j1 To j2
            e = MPC1(Trim(e), A(J) * B(I - J))
            If e > 2040000000 Then '减少进位次数
                e = e - 2040000000
                e1 = e1 + 204000
            End If
        Next J

        If j1 > 1 Then j1 = j1 - 1
base = 10000
        d = e \ base
        c(I) = e - d * base
        If Len(c(I)) < 4 Then
        c(I) = String(4 - Len(c(I)), "0") & c(I)
        Else
        c(I) = c(I)
        End If
jc = c(I) & jc
        e1 = e1 + d
    Next I
    jc = d & jc
   MbC4 = qdqd0(Trim(jc))
  End Function



Public Function MBBC(D1 As String) As String 'kai pingfang
If Len(D1) < 10 Then
jss = Int(Sqr(D1))
JW = Val(D1) - (jss) ^ 2
  If JW = 0 Then
  MBBC = jss
  Else
  MBBC = jss & "/" & JW
    End If
Else
Dim x 'shuju changdu
x = Len(D1) \ 4
D2 = String(4 - Len(D1) + 4 * x, "0") & D1
Dim A() As String
ReDim A(4 To 4 * x + 4)
Dim B() As String
ReDim B(2 To 2 * x)
Dim I, J, js
  For I = 4 To 4 * x + 4 Step 4
  
A(I) = Mid(D2, I - 3, 4)
js = Int(Sqr(Val(A(4) & A(8))))
JW = Val(A(4) & A(8)) - (js) ^ 2
Next
   J = 4
   Do While J <= 2 * x
   
   jws = MPC1(JW & "0000", A(2 * J + 4))
   If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then
    B(J) = "00"
    Else
    jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2)
    If Len(jwc) > 2 Then
     B(J) = 99
     Else
     B(J) = jwc
     End If
   
     
     Do While MBJC(Trim(jws), MbC(MPC1(B(J), MbC(Trim(js), 200)), B(J))) = -1
     
     B(J) = B(J) - 1
     
               Loop
          End If
          JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), B(J)), B(J)))
      
     js = MPC1(MbC(Trim(js), 100), Trim(B(J)))
     
      
   J = J + 2
   If JW = 0 Then
      
   MBBC = js
   Else
   MBBC = js & "/" & JW
   End If
   Loop
   
End If
End Function

Public Function MBJC(D1 As String, D2 As String) As String ';bijiao
If Len(D1) <= 10 And Len(D2) <= 10 Then
If Val(D1) > Val(D2) Then
MBJC = 1
Else
If Val(D1) = Val(D2) Then
MBJC = 0
Else
MBJC = -1
End If
End If
Else

If Len(D1) > Len(D2) Then
MBJC = 1
Else
If Len(D1) < Len(D2) Then
MBJC = -1
Else
If Len(D1) = Len(D2) Then
Dim x, Y
x = Len(D1) \ 4: Y = Len(D2) \ 4
Dim A() As String, B() As String
ReDim A(4 To 4 * x + 4)
ReDim B(4 To 4 * Y + 4)
If Val(Left(D1, Len(D1) - 4 * x)) > Val(Left(D2, Len(D2) - 4 * Y)) Then
  MBJC = 1
  Else
  If Val(Left(D1, Len(D1) - 4 * x)) < Val(Left(D2, Len(D2) - 4 * Y)) Then
  MBJC = -1
  Else
  For I = 4 To 4 * x Step 4
  A(I) = Mid(D1, Len(D1) - I + 1, 4)
  B(I) = Mid(D2, Len(D2) - I + 1, 4)
  Next
  J = 4 * x
  Do While A(J) = B(J) And J >= 8
  
  J = J - 4
     Loop
     
     
   If Val(A(J)) - Val(B(J)) > 0 Then
   MBJC = 1
   Else
   If Val(A(J)) - Val(B(J)) < 0 Then
   MBJC = -1
   Else
   MBJC = 0
   End If
   
  End If
  
  
  
End If
End If
End If
End If
End If
End If
End Function

ysr

Public Function MCC(D1 As String, D2 As String) As String ';除数少于8位的除法
If Len(D1) < Len(D2) Then
   MCC = "0" & "/" & D1
   Else
   If Len(D1) < 9 Then
    MCC = Val(D1) \ Val(D2) & "/" & Val(D1) - (Val(D1) \ Val(D2)) * Val(D2)
     If Mid(MCC, InStr(MCC, "/") + 1) = 0 Then
  MCC = Left(MCC, InStr(MCC, "/") - 1)
Else
MCC = MCC
End If
   
    Else
   
   Dim x ';fen duan changdu
   x = Len(D1)
   
     
   
     Dim A() As String
      ReDim A(1 To x)  ';定义数组的储存空间
      For I = 1 To x Step 1  ';把被除数各位放在a()中
       A(I) = Mid(D1, I, 1)
        
      
       Next I
      Dim B() As String
      JW = 0
     ReDim B(1 To x)
     For J = 1 To x Step 1
    B(J) = Val(JW & A(J)) \ Val(D2)
      JW = Val(JW & A(J)) - Val(B(J)) * Val(D2)
       Next J
       For r = 1 To x
       If JW = 0 Then
          MCC = MCC & B(r)
          Else
          CJ = CJ & B(r)
          MCC = CJ & "/" & JW
      
    End If
   
    For I = 1 To Len(MCC)
   If Not Mid(MCC, I, 1) = "0" Then
       Exit For
   End If
Next
strtmp = Mid(MCC, I)
If Len(strtmp) = 0 Then
MCC = "0"
Else
MCC = strtmp
End If
   
   Next
   
   End If
     
     End If
   
End Function

Public Function MCC4(D1 As String, D2 As String) As String ';大整数的除法
Dim ss
ss = MBJC(D1, D2)
If ss = -1 Then
MCC4 = "0" & "/" & D1
  Else
  If ss = 0 Then
   MCC4 = 1
   Else
   If Len(D1) = Len(D2) Then
     s = Val(Left(D1, 1)) \ Val(Left(D2, 1))

Do While MBJC(MbC(Trim(s), Trim(D2)), D1) = 1
  s = s - 1
  Loop
  If MBJC(MbC(Trim(s), Trim(D2)), D1) = 0 Then
   MCC4 = s
   Else
   MCC4 = s & "/" & MPC(Trim(D1), MbC(Trim(s), Trim(D2)))

End If
    Else
    If Len(D2) < 9 Then
     MCC4 = MCC(D1, D2)
     Else
    Dim x, Y ';定义分段长度
    x = Len(D1): Y = Len(D2)
   
Dim JW, jcc, jss, jcs

  Dim A() As String, B() As String
  
  ReDim A(1 To x)
  ReDim B(1 To Y)
  For I = 1 To x
  A(I) = Mid(D1, I, 1)
  Next
  For J = 1 To Y
  B(J) = Mid(D2, J, 1)
  Next
  jcc = Val(A(1) & A(2)) \ Val(B(1) & B(2))
   
      
        
  jss = MbC(Trim(jcc), D2)
   For i1 = 1 To Y
    jws = jws & A(i1)
      Next
      
      Do While MBJC(Trim(jws), Trim(jss)) = -1
      jcc = jcc - 1
      jss = MbC(Trim(jcc), D2)
      Loop
  JW = MPC(Trim(jws), Trim(jss))
  
    z = x - Y
   
    Dim c() As String
    ReDim c(1 To z)
    For s = 1 To z
     If MBJC(JW & A(s + Y), D2) = -1 Then
       c(s) = "0"
       Else
     jwc = Val(Left(JW & A(s + Y), 3)) \ Val(Left(D2, 2))
      If Len(jwc) > 1 Then
      c(s) = "9"
       Else
        c(s) = jwc
         End If
      
     Do While MBJC(JW & A(s + Y), MbC(Val(c(s)), D2)) = -1
    c(s) = Right(10000 + Val(c(s) - 1), 1)
     Loop
     End If
   
     JW = MPC(JW & A(s + Y), MbC(Val(c(s)), D2))
     
    jcc = jcc & c(s)
    Next s
    If JW = 0 Then
    MCC4 = jcc
    Else
    MCC4 = jcc & "/" & JW
    End If
   
  For I = 1 To Len(MCC4)
    If Not Mid(MCC4, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MCC4, I)
  If Len(strtmp) = 0 Then
  MCC4 = "0"
  Else
MCC4 = strtmp
End If
   
   
   
    End If
   
   
   
   
   
  
  End If
End If
End If
End Function

Public Function MCC1(D1 As String, D2 As String) As String ';大整数的除法
If Len(D1) < 500 Or Len(D2) < 500 Then
MCC1 = MCC4(Trim(D1), Trim(D2))
Else
Dim A, B
  A = Trim(D1): B = Trim(D2): b3 = B: a3 = A
  If Len(B) = 1 Then
  X1 = Mid(B, 1, 1): X2 = 1 / X1 - 0.01
  Else
  X1 = Mid(B, 1, 2): X2 = 10 / X1 - 0.01
  End If
  x = Mid(X2, 1, 4)
  Y = 0: x3 = 0
  sb = Len(a3) + Len(b3) - 1 + 10
  If Len(a3) = Len(b3) And MBJC(Trim(a3), Trim(b3)) = 0 Then
  a1 = 1
  Text3 = a1
  Else
  If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) = 0 And Val(Len(qdhz0(Trim(a3)))) = Val(Len(b3)) Then
  a1 = 1 & String(Len(a3) - Len(qdhz0(Trim(a3))), "0")
  Else
  
  A = A & String(10, "0"): B = B & String(10 + Len(a3), "0")
  x = qdqd0(ydxsd(Trim(x), Val(sb)))
  Y1 = 2 & String(Val(sb), "0")
  Do While MBJC(MPC(Trim(x), Trim(x3)), 1) >= 0
  
  s3 = s3 + 1
  Y = mbc2(Trim(x), MPC(Trim(Y1), mbc2(Trim(B), Trim(x), Val(sb))), Val(sb))
  x3 = x
  x = Trim(Y)
  Loop
  a1 = mbc2(Trim(Y), Trim(A), Val(sb))
  s = Len(a3) - Len(b3)
  a1 = qdqd0(Trim(a1))
  
  If MBJC(Mid(a3, 1, Len(b3)), Trim(b3)) < 0 Then
  a1 = tjxsd(Trim(a1), Len(a1) - s)
  Else
  a1 = tjxsd(Trim(a1), Len(a1) - s - 1)
  End If
  End If
  
  If InStr(a1, ".") = 0 Then
  a1 = a1
  Else
  a1 = Left(a1, InStr(a1, ".") - 1)
  End If
  ja = MPC(Trim(a3), MbC4(Trim(b3), Trim(a1)))
  Do While MBJC(Trim(ja), Trim(b3)) >= 0
  ja = MPC(Trim(ja), Trim(b3))
  s5 = s5 + 1
  Loop
  a1 = MPC1(Trim(a1), Trim(s5))
  If ja = 0 Then
  MCC1 = a1
  Else
  MCC1 = a1 & "/" & ja
  End If
  End If
  End If
End Function
Private Function tjxsd(sa As String, sd As String) As String
  If Val(Len(sa)) > Val(sd) Then
  tjxsd = Left(sa, Val(Len(sa)) - Val(sd)) & "." & Mid(sa, Val(Len(sa)) - Val(sd) + 1)
  Else
  If Val(Len(sa)) = Val(sd) Then
    tjxsd = "0." & sa
    Else
    tjxsd = "0." & String(Val(sd) - Val(Len(sa)), "0") & Trim(sa)
    End If
    End If

  End Function


Public Function MbC(D1 As String, D2 As String) As String
Dim j1&, j2&, e&, d&, e1&, m, n
If Len(D1) > 700000 Or Len(D2) > 700000 Then
MbC = MbC4(Trim(D1), Trim(D2))
Else
   ' 按列法计算C=A*B
m = Trim(D1): n = Trim(D2)
x = Len(m) \ 4: Y = Len(n) \ 4
m = String(4 * x + 4 - Len(m), "0") & m
n = String(4 * Y + 4 - Len(n), "0") & n
x = x + 1: Y = Y + 1
Dim A(), B()
ReDim A(1 To x): ReDim B(1 To Y)
For i1 = 1 To x
A(i1) = Val(Mid(m, i1 * 4 - 3, 4))
Next
For i2 = 1 To Y
B(i2) = Val(Mid(n, i2 * 4 - 3, 4))
Next
ma = x: mb = Y
    MC = ma + mb
    ReDim c(MC)
    e1 = 0
    j1 = ma: j2 = ma
    For I = MC To 2 Step -1
        If I <= ma Then j2 = I - 1
        e = e1: e1 = 0
        For J = j1 To j2
            e = e + A(J) * B(I - J)
            If e > 2040000000 Then '减少进位次数
                e = e - 2040000000
                e1 = e1 + 204000
            End If
        Next J

        If j1 > 1 Then j1 = j1 - 1
base = 10000
        d = e \ base
        c(I) = e - d * base
        If Len(c(I)) < 4 Then
        c(I) = String(4 - Len(c(I)), "0") & c(I)
        Else
        c(I) = c(I)
        End If
jc = c(I) & jc
        e1 = e1 + d
    Next I
    jc = d & jc
   MbC = qdqd0(Trim(jc))
   End If
End Function



Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
  Dim x, Y ';两数长度
If Len(D1) >= Len(D2) Then
  D4 = String(Len(D1) - Len(D2), "0") & D2
  D3 = D1
  Else
  D4 = D2
  D3 = String(Len(D2) - Len(D1), "0") & D1
  End If
  x = Len(D3) \ 8: Y = Len(D4) \ 8
  If Len(D3) > 8 * x Then
  D3 = String(8 * x + 8 - Len(D3), "0") & D3
  D4 = String(8 * Y + 8 - Len(D4), "0") & D4
  x = x + 1: Y = Y + 1
  Else
  x = x: Y = Y
  D3 = D3: D4 = D4
  End If
  
  Dim A() As String, B1() As String, C1() As String, e1() As String
  ReDim A(1 To x)
  ReDim B1(1 To Y)
  ReDim C1(1 To x)
  ReDim e1(1 To x)
  Dim I, J, C2, CJ, JW
  For J = Y To 1 Step -1 ';D2
  JW = 1 ';yu jie weichuzhi
  B1(J) = Mid(D4, J * 8 - 7, 8) ';每位数
For I = x To 1 Step -1  ';D1
     A(I) = Mid(D3, I * 8 - 7, 8) ';每位数
   C1(I) = Val(1 & A(I)) - Val(B1(I)) - Val(1) + Val(JW) ';计算jia
     JW = C1(I) \ 10 ^ 8
     e1(I) = C1(I) Mod 10 ^ 8
     If Len(e1(I)) < 8 Then
     e1(I) = String(8 - Len(e1(I)), "0") & e1(I)
     Else
     e1(I) = e1(I)
     End If
     
    Next
    Next
    For r = 1 To x
    MPC = MPC & e1(r)
    If Len(MPC) > Len(D1) Then
    MPC = Mid(MPC, Len(MPC) - Len(D1) + 1)
    Else
    MPC = MPC
    End If
    For I = 1 To Len(MPC)
      If Not Mid(MPC, I, 1) = "0" Then
          Exit For
      End If
  Next
  strtmp = Mid(MPC, I)
    If Len(strtmp) = 0 Then
    MPC = "0"
    Else
  MPC = strtmp
  End If
    Next
   
   
  End Function
  Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '两数长度

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
D3 = D1
Else
D4 = D2
D3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(D3): Y = Len(D4)
Dim A() As Integer, B1() As Integer, C1() As Integer, e1() As Integer
ReDim A(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim e1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '进位清0
B1(J) = Mid$(D4, J, 1) '每位数
For I = x To 1 Step -1  'D1
   A(I) = Mid$(D3, I, 1) '每位数
   C1(I) = A(I) + B1(I) + JW '计算jia
   JW = C1(I) \ 10
   e1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & e1(r)
  Else
  jc = jc & e1(r)
  MPC1 = JW & jc
  End If
  Next
  
End Function


Private Function zzxc(sa As String, sb As String) As String
Dim A, B, c, d, r
  A = Trim(sa)
  B = Trim(sb)
  If Len(A) < 10 And Len(B) < 10 Then
  
  If Val(A) > Val(B) Then
     c = A
     d = B
  Else
     c = B
     d = A
  End If
Do Until Val(c) Mod Val(d) = 0
     r = c Mod d
     c = d
     d = r
  Loop
  
  Else
  
  If MBJC(Trim(A), Trim(B)) >= 1 Then
  c = A
  d = B
  Else
  c = B
  d = A
  End If
  Do Until zhengchuqyushu(MCC1(Trim(c), Trim(d))) = 0
  r = zhengchuqyushu(MCC1(Trim(c), Trim(d)))
  c = d
  d = r
  Loop
  End If

  
  zzxc = d
  
End Function

Private Function qniyuan(sa As String, sb As String) As String
Dim n, p, A, B, c, d, r
  n = Trim(sa)
  p = Trim(sb)
  A = 1
  B = 0
  c = 0
  d = 1
  If Len(n) < 10 And Len(p) < 10 Then
  
  If Val(n) > Val(p) Then
     m = n
     q = p
     s1 = 1
  Else
     m = p
     q = n
     s1 = 0
  End If
Do Until Val(m) Mod Val(q) = 0
    s = m \ q
     r = m Mod q
     s1 = s1 + 1
     If s1 Mod 2 = 1 Then
     A = A
     B = A * s + B
     c = c
     d = c * s + d
     Else
     B = B
     A = A + B * s
     d = d
     c = c + d * s
     End If
     m = q
     q = r
  Loop
  If Val(A + B * m) = p Then
  B = B
  A = A + B * (m - 1)
  d = d
  c = c + d * (m - 1)
  Else
  If Val(B + A * m) = p Then
  A = A
  B = B + A * m
  c = c
  d = d + c * m
  Else
  B = B
  A = A + B * (m - 1)
  d = d
  c = c + d * (m - 1)
  End If
  End If
x = (A + B) Mod p
  Y = (c + d) Mod n
  
  
  Else
  
  If MBJC(Trim(n), Trim(p)) >= 1 Then
  m = n
  q = p
  s1 = 1
  Else
  m = p
  q = n
  s1 = 0
  End If
  Do Until zhengchuqyushu(MCC1(Trim(m), Trim(q))) = 0
  s = zhengchuqy(MCC1(Trim(m), Trim(q)))
  r = zhengchuqyushu(MCC1(Trim(m), Trim(q)))
  s1 = s1 + 1
  If s1 Mod 2 = 1 Then
  A = A
  B = MPC1(MbC(Trim(A), Trim(s)), Trim(B))
  c = c
  d = MPC1(MbC(Trim(c), Trim(s)), Trim(d))
  Else
  B = B
  A = MPC1(Trim(A), MbC(Trim(B), Trim(s)))
  d = d
  c = MPC1(Trim(c), MbC(Trim(d), Trim(s)))
  End If
  
  m = q
  q = r
  Loop
  
  If MPC1(Trim(A), MbC(Trim(B), Trim(m))) = p Then
  B = B
  A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
  d = d
  c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
  Else
  If MPC1(Trim(B), MbC(Trim(A), Trim(m))) = p Then
  A = A
  B = MPC1(Trim(B), MbC(Trim(A), Trim(m)))
  c = c
  d = MPC1(Trim(d), MbC(Trim(c), Trim(m)))
  Else
  B = B
  A = MPC1(Trim(A), MbC(Trim(B), MPC(Trim(m), 1)))
  d = d
  c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1)))
  End If
  End If
Do While Left(A, 1) = "0"
    A = Mid(A, 2)
Loop
  
  End If
  
  qniyuan = A
End Function

Private Function qksmimo(sa As String, sb As String, sc As String) As String
Dim c, e, n, d
c = Trim(sa)
e = Trim(sb)
n = Trim(sc)
d = 1
If Len(c) < 5 And Len(e) < 5 And Len(n) < 5 Then
c = Val(c): n = Val(n)
Do While e > 0
If Right(e, 1) Mod 2 = 0 Then
c = c * c Mod n
e = e / 2

Else
d = d * c Mod n
e = e - 1
End If
Loop
Else
c = c
Do While MBJC(Trim(e), 1) >= 0
If Right(e, 1) Mod 2 = 0 Then
c = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(c)), Trim(n)))
e = zhengchuqy(MCC1(Trim(e), 2))
Else
d = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(d)), Trim(n)))
e = MPC(Trim(e), 1)
End If
Loop
End If

qksmimo = d
End Function

Private Function fenjieyinzi(sa As String) As String
Dim A, B
Dim x As String
x = sa
B1 = Sqr(Val(x)) / 2
If InStr(B1, ".") = 0 Then
B = B1
Else
B = Left(B1, InStr(B1, ".") - 1)
End If
If x = 3 Or x = 2 Then
A = True
Else
If Right(x, 1) Mod 2 = 0 Then
A = False
Else
For I = 3 To 2 * B + 1 Step 2
b2 = x / I
If InStr(b2, ".") = 0 Then
A = False
Exit For

Else: A = True

End If
Next
End If
End If
If A = True Then
fenjieyinzi = "这是个素数"
Else
fenjieyinzi = "2*2"
End If


End Function
Private Function fenjieyinzi0(sa As String) As String
Dim A, n
n = Trim(sa)
If Len(n) < 11 Then
fenjieyinzi0 = fenjieyinzi(Trim(n))
Else
n1 = MPC(Trim(n), 1)
A = 123
'a为明文
a1 = zzxc(Trim(n), Trim(A))
If Val(a1) > 1 Then
fenjieyinzi0 = a1 & "*"
Else
c = 999
'c为公约
Do While zzxc(Trim(n1), Trim(c)) > 1
c = Val(c - 1)
Loop
d = qniyuan(Trim(c), Trim(n1))
'd为逆元为私钥
a2 = qksmimo(Trim(A), Trim(c), Trim(n))
'a2为密文
a3 = qksmimo(Trim(a2), Trim(d), Trim(n))
If MBJC(Trim(a3), Trim(A)) = 0 Then
fenjieyinzi0 = "这是素数有"
Else
fenjieyinzi0 = "2*2"
End If
End If
End If


End Function

ysr

Private Function jcjs(sa As String) As String

Dim s
s = 1
For I = 1 To sa
s = MbC(Trim(s), Val(I))
Next
jcjs = s



   
End Function

ysr

Private Sub Command1_Click() '求由2个孪生素数对组成的4生素数组的程序
Dim A, B
A = Val(Text1)
a1 = A
q = Val(Text2)
ts = Timer
m = Sqr(q)
t = Trim(Text4)
If Right(A, 1) Mod 2 = 0 Then
A = A + 1
Else
A = A
End If
s = 0
a2 = A
Do While a2 <= m
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0 Or InStr(fenjieyinzi0(Trim(a2)), "*") > 0
a2 = a2 + 2
Loop
Do While Right(MPC1(MPC1(Trim(a2), Trim(t)), 4), 1) = 5 Or Right(MPC1(MPC1(Trim(a2), Trim(t)), 2), 1) = 5
a2 = Val(a2 + 1)
Loop
Do While zzxc(Trim(a2), MPC1(MPC1(Trim(a2), Trim(t)), 4)) > 1 Or zzxc(MPC1(MPC1(Trim(a2), Trim(t)), 2), Trim(a2)) > 1
a2 = Val(a2 + 1)
Loop
Do While zzxc(Val(a2 + 2), MPC1(MPC1(Trim(a2), Trim(t)), 2)) > 1 Or zzxc(MPC1(MPC1(Trim(a2), Trim(t)), 4), Val(a2 + 2)) > 1
a2 = Val(a2 + 1)
Loop
B1 = a2
b2 = a2 + 2
b3 = MPC1(Trim(b2), Trim(t))
b4 = MPC1(Trim(b3), 2)

C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Val(b2))
c3 = fenjieyinzi0(Trim(b3))
D1 = fenjieyinzi0(Trim(b4))

If InStr(C1, "*") = 0 And InStr(D1, "*") = 0 And InStr(C2, "*") = 0 And InStr(c3, "*") = 0 Then
s = s + 1
Print B1, b2, b3, b4
Text3 = Text3 & "/" & B1 & "/" & b2 & "/" & b3 & "/" & b4 & vbCrLf
Else
s = s
End If
a2 = a2 + 2

Loop
a2 = a2
s1 = s
Do While a2 <= q
Do While InStr(fenjieyinzi0(Trim(a2)), "*") > 0 Or InStr(fenjieyinzi0(Trim(a2)), "*") > 0
a2 = a2 + 2
Loop

Do While Right(MPC1(MPC1(Trim(a2), Trim(t)), 4), 1) = 5 Or Right(MPC1(MPC1(Trim(a2), Trim(t)), 2), 1) = 5
a2 = Val(a2 + 1)
Loop
Do While zzxc(Trim(a2), MPC1(MPC1(Trim(a2), Trim(t)), 4)) > 1 Or zzxc(MPC1(MPC1(Trim(a2), Trim(t)), 2), Trim(a2)) > 1
a2 = Val(a2 + 1)
Loop
Do While zzxc(Val(a2 + 2), MPC1(MPC1(Trim(a2), Trim(t)), 2)) > 1 Or zzxc(MPC1(MPC1(Trim(a2), Trim(t)), 4), Val(a2 + 2)) > 1
a2 = Val(a2 + 1)
Loop
B1 = a2
b2 = a2 + 2
b3 = MPC1(Trim(b2), Trim(t))
b4 = MPC1(Trim(b3), 2)

C1 = fenjieyinzi0(Val(B1))
C2 = fenjieyinzi0(Val(b2))
c3 = fenjieyinzi0(Trim(b3))
D1 = fenjieyinzi0(Trim(b4))

If InStr(C1, "*") = 0 And InStr(D1, "*") = 0 And InStr(C2, "*") = 0 And InStr(c3, "*") = 0 Then
s1 = s1 + 1
Print B1, b2, b3, b4
Text3 = Text3 & "/" & B1 & "/" & b2 & "/" & b3 & "/" & b4 & vbCrLf
Else
s1 = s1
End If
a2 = a2 + 2

Loop
Combo1 = a1 & "与" & q & "之间的素数打头有" & s1 & "组差为2和" & t & "和2的4生素数对: (用时" & Timer - ts & "秒）" & vbCrLf & Text3

End Sub


Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Combo1 = ""
Form1.Cls
End Sub
这样程序速度又提高了一点点。