ModBase.vb 161 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349
  1. Imports System.Globalization
  2. Imports System.IO.Compression
  3. Imports System.Net.Sockets
  4. Imports System.Runtime.CompilerServices
  5. Imports System.Security.Cryptography
  6. Imports System.Security.Principal
  7. Imports System.Text.RegularExpressions
  8. Imports System.Threading.Tasks
  9. Imports System.Xaml
  10. Imports Newtonsoft.Json
  11. Public Module ModBase
  12. #Region "声明"
  13. '下列版本信息由更新器自动修改
  14. Public Const VersionBaseName As String = "2.12.2" '不含分支前缀的显示用版本名
  15. Public Const VersionStandardCode As String = "2.12.2." & VersionBranchCode '标准格式的四段式版本号
  16. Public Const CommitHash As String = "" 'Commit Hash,由 GitHub Workflow 自动替换
  17. #If BETA Then
  18. Public Const VersionCode As Integer = 379 'Release
  19. #Else
  20. Public Const VersionCode As Integer = 380 'Snapshot
  21. #End If
  22. '自动生成的版本信息
  23. Public Const VersionDisplayName As String = VersionBranchName & " " & VersionBaseName
  24. #If RELEASE Then
  25. Public Const VersionBranchName As String = "Snapshot"
  26. Public Const VersionBranchCode As String = "0"
  27. #ElseIf BETA Then
  28. Public Const VersionBranchName As String = "Release"
  29. Public Const VersionBranchCode As String = "50"
  30. #Else
  31. Public Const VersionBranchName As String = "Debug"
  32. Public Const VersionBranchCode As String = "100"
  33. #End If
  34. ''' <summary>
  35. ''' 主窗口句柄。
  36. ''' </summary>
  37. Public Handle As IntPtr
  38. ''' <summary>
  39. ''' 程序的启动路径,以“\”结尾。
  40. ''' </summary>
  41. Public Path As String = AppDomain.CurrentDomain.SetupInformation.ApplicationBase
  42. ''' <summary>
  43. ''' 包含程序名的完整路径。
  44. ''' </summary>
  45. Public PathWithName As String = Path & AppDomain.CurrentDomain.SetupInformation.ApplicationName
  46. ''' <summary>
  47. ''' 程序内嵌图片文件夹路径,以“/”结尾。
  48. ''' </summary>
  49. Public PathImage As String = "pack://application:,,,/Plain Craft Launcher 2;component/Images/"
  50. ''' <summary>
  51. ''' 当前程序的语言。
  52. ''' </summary>
  53. Public Lang As String = "zh_CN"
  54. ''' <summary>
  55. ''' 设置对象。
  56. ''' </summary>
  57. Public Setup As New ModSetup
  58. ''' <summary>
  59. ''' 程序的打开计时。
  60. ''' </summary>
  61. Public ApplicationStartTick As Long = GetTimeMs()
  62. ''' <summary>
  63. ''' 程序打开时的时间。
  64. ''' </summary>
  65. Public ApplicationOpenTime As Date = Date.Now
  66. ''' <summary>
  67. ''' 识别码。
  68. ''' </summary>
  69. Public Identify As String = SecretGetIdentify()
  70. ''' <summary>
  71. ''' 程序是否已结束。
  72. ''' </summary>
  73. Public IsProgramEnded As Boolean = False
  74. ''' <summary>
  75. ''' 是否为 32 位系统。
  76. ''' </summary>
  77. Public Is32BitSystem As Boolean = Not Environment.Is64BitOperatingSystem
  78. ''' <summary>
  79. ''' 是否使用 GBK 编码。
  80. ''' </summary>
  81. Public IsGBKEncoding As Boolean = Encoding.Default.CodePage = 936
  82. ''' <summary>
  83. ''' 系统盘盘符,以 \ 结尾。例如 “C:\”。
  84. ''' </summary>
  85. Public OsDrive As String = Environment.GetLogicalDrives().Where(Function(p) Directory.Exists(p)).First.ToUpper.First & ":\" '#3799
  86. ''' <summary>
  87. ''' 程序的缓存文件夹路径,以 \ 结尾。
  88. ''' </summary>
  89. Public PathTemp As String = If(Setup.Get("SystemSystemCache") = "", IO.Path.GetTempPath() & "PCL\", Setup.Get("SystemSystemCache")).ToString.Replace("/", "\").TrimEnd("\") & "\"
  90. ''' <summary>
  91. ''' AppData 中的 PCL 文件夹路径,以 \ 结尾。
  92. ''' </summary>
  93. Public PathAppdata As String = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\PCL\"
  94. #End Region
  95. #Region "矢量图标"
  96. Public Class Logo
  97. ''' <summary>
  98. ''' 图标按钮,心(空心),1.1x
  99. ''' </summary>
  100. Public Const IconButtonLikeLine As String = "M512 896a42.666667 42.666667 0 0 1-30.293333-12.373333l-331.52-331.946667a224.426667 224.426667 0 0 1 0-315.733333 223.573333 223.573333 0 0 1 315.733333 0L512 282.026667l46.08-46.08a223.573333 223.573333 0 0 1 315.733333 0 224.426667 224.426667 0 0 1 0 315.733333l-331.52 331.946667A42.666667 42.666667 0 0 1 512 896zM308.053333 256a136.533333 136.533333 0 0 0-97.28 40.106667 138.24 138.24 0 0 0 0 194.986666L512 792.746667l301.226667-301.653334a138.24 138.24 0 0 0 0-194.986666 141.653333 141.653333 0 0 0-194.56 0l-76.373334 76.8a42.666667 42.666667 0 0 1-60.586666 0L405.333333 296.106667A136.533333 136.533333 0 0 0 308.053333 256z"
  101. ''' <summary>
  102. ''' 图标按钮,心(实心),1.1x
  103. ''' </summary>
  104. Public Const IconButtonLikeFill As String = "M700.856 155.543c-74.769 0-144.295 72.696-190.046 127.26-45.737-54.576-115.247-127.26-190.056-127.26-134.79 0-244.443 105.78-244.443 235.799 0 77.57 39.278 131.988 70.845 175.713C238.908 694.053 469.62 852.094 479.39 858.757c9.41 6.414 20.424 9.629 31.401 9.629 11.006 0 21.998-3.215 31.398-9.63 9.782-6.662 240.514-164.703 332.238-291.701 31.587-43.724 70.874-98.143 70.874-175.713-0.001-130.02-109.656-235.8-244.445-235.8z m0 0"
  105. ''' <summary>
  106. ''' 图标按钮,垃圾桶,1.1x
  107. ''' </summary>
  108. Public Const IconButtonDelete As String = "M520.192 0C408.43 0 317.44 82.87 313.563 186.734H52.736c-29.038 0-52.663 21.943-52.663 49.079s23.625 49.152 52.663 49.152h58.075v550.473c0 103.35 75.118 187.757 167.717 187.757h472.43c92.599 0 167.716-83.894 167.716-187.757V285.477h52.59c29.038 0 52.59-21.943 52.663-49.08-0.073-27.135-23.625-49.151-52.663-49.151H726.235C723.237 83.017 631.955 0 520.192 0zM404.846 177.957c3.803-50.03 50.176-89.015 107.447-89.015 57.197 0 103.57 38.985 106.788 89.015H404.92zM284.379 933.669c-33.353 0-69.997-39.351-69.997-95.525v-549.01H833.39v549.522c0 56.247-36.645 95.525-69.998 95.525H284.379v-0.512z M357.23 800.695a48.274 48.274 0 0 0 47.616-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.69 49.006V751.69c0 27.282 20.846 49.006 47.617 49.006z m166.62 0a48.274 48.274 0 0 0 47.688-49.006V471.7a48.274 48.274 0 0 0-47.689-49.08 48.274 48.274 0 0 0-47.543 49.006V751.69c0 27.282 21.431 49.006 47.543 49.006z m142.92 0a48.274 48.274 0 0 0 47.543-49.006V471.7a48.274 48.274 0 0 0-47.543-49.08 48.274 48.274 0 0 0-47.616 49.006V751.69c0 27.282 20.773 49.006 47.543 49.006z"
  109. ''' <summary>
  110. ''' 图标按钮,禁止,1x
  111. ''' </summary>
  112. Public Const IconButtonStop As String = "M508 990.4c-261.6 0-474.4-212-474.4-474.4S246.4 41.6 508 41.6s474.4 212 474.4 474.4S769.6 990.4 508 990.4zM508 136.8c-209.6 0-379.2 169.6-379.2 379.2 0 209.6 169.6 379.2 379.2 379.2s379.2-169.6 379.2-379.2C887.2 306.4 717.6 136.8 508 136.8zM697.6 563.2 318.4 563.2c-26.4 0-47.2-21.6-47.2-47.2 0-26.4 21.6-47.2 47.2-47.2l379.2 0c26.4 0 47.2 21.6 47.2 47.2C744.8 542.4 724 563.2 697.6 563.2z"
  113. ''' <summary>
  114. ''' 图标按钮,勾选,1x
  115. ''' </summary>
  116. Public Const IconButtonCheck As String = "M512 0a512 512 0 1 0 512 512A512 512 0 0 0 512 0z m0 921.6a409.6 409.6 0 1 1 409.6-409.6 409.6 409.6 0 0 1-409.6 409.6z M716.8 339.968l-256 253.44L328.192 460.8A51.2 51.2 0 0 0 256 532.992l168.448 168.96a51.2 51.2 0 0 0 72.704 0l289.28-289.792A51.2 51.2 0 0 0 716.8 339.968z"
  117. ''' <summary>
  118. ''' 图标按钮,笔,1x
  119. ''' </summary>
  120. Public Const IconButtonEdit As String = "M732.64 64.32C688.576 21.216 613.696 21.216 569.6 64.32L120.128 499.52c-17.6 12.896-26.432 30.144-30.848 51.68L32 870.048c0 25.856 8.8 56 26.432 73.248 17.632 17.216 17.632 48.704 88.64 48.704h13.248l326.08-56c22.016-4.32 39.68-12.928 52.864-30.176l449.472-435.2c22.048-21.536 35.264-47.36 35.264-77.536 0-30.176-13.216-56-35.264-77.568l-256.096-251.2zM139.712 903.776l56-326.912 311.04-295.136 267.104 269.44-310.976 295.168-323.168 57.44zM844.576 467.84l-273.984-260.672 61.856-59.84c8.832-8.512 26.528-8.512 39.776 0l234.24 226.496c4.384 4.288 8.832 12.8 8.832 17.088s-4.416 8.544-8.864 12.8l-61.856 64.128z"
  121. ''' <summary>
  122. ''' 图标按钮,齿轮,1.1x
  123. ''' </summary>
  124. Public Const IconButtonSetup As String = "M651.946667 1001.813333c-22.186667 0-42.666667-10.24-61.44-27.306666-23.893333-23.893333-49.493333-35.84-75.093334-35.84-29.013333 0-56.32 11.946667-73.386666 30.72v3.413333c-17.066667 17.066667-42.666667 27.306667-66.56 27.306667h-6.826667c-6.826667 0-11.946667-1.706667-15.36-1.706667l-6.826667-1.706667c-64.853333-20.48-121.173333-54.613333-168.96-98.986666-29.013333-23.893333-37.546667-63.146667-25.6-95.573334 8.533333-23.893333 5.12-51.2-10.24-75.093333-15.36-27.306667-34.133333-40.96-59.733333-47.786667h-1.706667l-5.12-1.706666c-35.84-8.533333-61.44-34.133333-66.56-69.973334C1.706667 575.146667 0 537.6 0 512c0-32.426667 3.413333-63.146667 8.533333-93.866667v-6.826666l3.413334-8.533334c10.24-23.893333 23.893333-40.96 44.373333-51.2 5.12-3.413333 11.946667-6.826667 20.48-8.533333 27.306667-8.533333 51.2-25.6 63.146667-44.373333 13.653333-23.893333 17.066667-52.906667 10.24-81.92-11.946667-34.133333 0-71.68 30.72-93.866667 44.373333-37.546667 97.28-68.266667 158.72-93.866667l3.413333-1.706666c44.373333-13.653333 75.093333 3.413333 92.16 20.48 23.893333 23.893333 49.493333 35.84 75.093333 35.84 30.72 0 56.32-10.24 71.68-30.72l3.413334-3.413334c27.306667-27.306667 63.146667-35.84 93.866666-22.186666 63.146667 22.186667 117.76 54.613333 165.546667 97.28 29.013333 23.893333 37.546667 63.146667 25.6 95.573333-8.533333 23.893333-5.12 51.2 10.24 75.093333 15.36 27.306667 34.133333 40.96 59.733333 47.786667h1.706667l5.12 1.706667c35.84 8.533333 61.44 34.133333 66.56 71.68 6.826667 30.72 10.24 63.146667 11.946667 93.866666v3.413334c0 32.426667-3.413333 63.146667-8.533334 93.866666v6.826667l-3.413333 8.533333c-10.24 23.893333-23.893333 40.96-44.373333 51.2-5.12 3.413333-11.946667 6.826667-20.48 8.533334-27.306667 8.533333-51.2 25.6-63.146667 46.08-13.653333 23.893333-17.066667 52.906667-10.24 81.92 11.946667 35.84-1.706667 75.093333-30.72 95.573333-44.373333 35.84-95.573333 66.56-157.013333 92.16-15.36 3.413333-27.306667 3.413333-35.84 3.413333z m3.413333-83.626666z m1.706667 0zM517.12 853.333333c47.786667 0 93.866667 20.48 134.826667 59.733334 1.706667 1.706667 3.413333 1.706667 3.413333 3.413333 52.906667-22.186667 97.28-49.493333 136.533333-80.213333l1.706667-1.706667v-3.413333c-13.653333-52.906667-8.533333-104.106667 17.066667-148.48 23.893333-39.253333 64.853333-69.973333 114.346666-85.333334 1.706667 0 3.413333-1.706667 6.826667-6.826666 5.12-25.6 8.533333-51.2 8.533333-78.506667-1.706667-29.013333-3.413333-56.32-10.24-81.92v-5.12h-1.706666c-51.2-11.946667-90.453333-39.253333-119.466667-87.04-27.306667-44.373333-34.133333-100.693333-17.066667-148.48l-1.706666-1.706667h-3.413334c-39.253333-35.84-85.333333-63.146667-136.533333-80.213333H648.533333s-1.706667 1.706667-3.413333 1.706667c-32.426667 39.253333-80.213333 59.733333-136.533333 59.733333-47.786667 0-93.866667-20.48-134.826667-59.733333l-1.706667-1.706667h-1.706666c-54.613333 22.186667-98.986667 49.493333-136.533334 80.213333l-1.706666 1.706667v3.413333c13.653333 52.906667 8.533333 104.106667-17.066667 148.48-23.893333 39.253333-64.853333 69.973333-114.346667 85.333334-1.706667 0-3.413333 1.706667-6.826666 6.826666-6.826667 25.6-8.533333 51.2-8.533334 78.506667 0 30.72 3.413333 58.026667 6.826667 76.8l1.706667 5.12h1.706666c51.2 11.946667 90.453333 39.253333 119.466667 87.04 27.306667 44.373333 34.133333 100.693333 17.066667 148.48l1.706666 1.706667 1.706667 1.706666c37.546667 35.84 83.626667 63.146667 134.826667 80.213334 1.706667 0 3.413333 0 3.413333 1.706666h1.706667s1.706667 0 5.12-1.706666c34.133333-37.546667 81.92-59.733333 136.533333-59.733334z m-6.826667-146.773333c-110.933333 0-199.68-85.333333-199.68-196.266667 0-109.226667 87.04-196.266667 199.68-196.266666s199.68 85.333333 199.68 196.266666c-1.706667 109.226667-88.746667 196.266667-199.68 196.266667z m0-307.2c-63.146667 0-114.346667 49.493333-114.346666 110.933333 0 63.146667 49.493333 110.933333 114.346666 110.933334 30.72 0 59.733333-11.946667 80.213334-32.426667 20.48-20.48 32.426667-49.493333 32.426666-78.506667 0-63.146667-49.493333-110.933333-112.64-110.933333z"
  125. ''' <summary>
  126. ''' 图标按钮,重置,0.9x
  127. ''' </summary>
  128. Public Const IconButtonReset As String = "M667.6817627 313.65283203l-45.28564454 55.76660156L858.06933594 391.27124023 787.61950684 165.93066406l-56.01379395 69.01611328A354.47387695 354.47387695 0 0 0 520.89892578 165.93066406C324.87536621 165.93066406 165.93066406 324.43041992 165.93066406 519.91015625c0 195.52917481 158.94470215 353.97949219 354.96826172 353.97949219a355.06713867 355.06713867 0 0 0 331.73217774-227.66418458 50.52612305 50.52612305 0 0 0-29.21813966-65.25878905 50.77331543 50.77331543 0 0 0-65.50598144 29.16870117A253.61938477 253.61938477 0 0 1 520.94836426 772.78796387c-140.05920411 0-253.61938477-113.21411133-253.61938477-252.87780762 0-139.61425781 113.56018067-252.82836914 253.61938477-252.82836914 53.59130859 0 104.46350098 16.61132813 146.73339843 46.57104492"
  129. ''' <summary>
  130. ''' 图标按钮,刷新,0.85x
  131. ''' </summary>
  132. Public Const IconButtonRefresh As String = "M875.52 148.48C783.36 56.32 655.36 0 512 0 291.84 0 107.52 138.24 30.72 332.8l122.88 46.08C204.8 230.4 348.16 128 512 128c107.52 0 199.68 40.96 271.36 112.64L640 384h384V0L875.52 148.48zM512 896c-107.52 0-199.68-40.96-271.36-112.64L384 640H0v384l148.48-148.48C240.64 967.68 368.64 1024 512 1024c220.16 0 404.48-138.24 481.28-332.8L870.4 645.12C819.2 793.6 675.84 896 512 896z"
  133. ''' <summary>
  134. ''' 图标按钮,软盘,1x
  135. ''' </summary>
  136. Public Const IconButtonSave As String = "M819.392 0L1024 202.752v652.16a168.96 168.96 0 0 1-168.832 168.768h-104.192a47.296 47.296 0 0 1-10.752 0H283.776a47.232 47.232 0 0 1-10.752 0H168.832A168.96 168.96 0 0 1 0 854.912V168.768A168.96 168.96 0 0 1 168.832 0h650.56z m110.208 854.912V242.112l-149.12-147.776H168.896c-41.088 0-74.432 33.408-74.432 74.432v686.144c0 41.024 33.344 74.432 74.432 74.432h62.4v-190.528c0-33.408 27.136-60.544 60.544-60.544h440.448c33.408 0 60.544 27.136 60.544 60.544v190.528h62.4c41.088 0 74.432-33.408 74.432-74.432z m-604.032 74.432h372.864v-156.736H325.568v156.736z m403.52-596.48a47.168 47.168 0 1 1 0 94.336H287.872a47.168 47.168 0 1 1 0-94.336h441.216z m0-153.728a47.168 47.168 0 1 1 0 94.4H287.872a47.168 47.168 0 1 1 0-94.4h441.216z"
  137. ''' <summary>
  138. ''' 图标按钮,信息,1.05x
  139. ''' </summary>
  140. Public Const IconButtonInfo As String = "M512 917.333333c223.861333 0 405.333333-181.472 405.333333-405.333333S735.861333 106.666667 512 106.666667 106.666667 288.138667 106.666667 512s181.472 405.333333 405.333333 405.333333z m0 106.666667C229.226667 1024 0 794.773333 0 512S229.226667 0 512 0s512 229.226667 512 512-229.226667 512-512 512z m-32-597.333333h64a21.333333 21.333333 0 0 1 21.333333 21.333333v320a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333V448a21.333333 21.333333 0 0 1 21.333333-21.333333z m0-192h64a21.333333 21.333333 0 0 1 21.333333 21.333333v64a21.333333 21.333333 0 0 1-21.333333 21.333333h-64a21.333333 21.333333 0 0 1-21.333333-21.333333v-64a21.333333 21.333333 0 0 1 21.333333-21.333333z"
  141. ''' <summary>
  142. ''' 图标按钮,列表,1x
  143. ''' </summary>
  144. Public Const IconButtonList As String = "M384 128h640v128H384zM160 192m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 448h640v128H384zM160 512m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0ZM384 768h640v128H384zM160 832m-96 0a96 96 0 1 0 192 0 96 96 0 1 0-192 0Z"
  145. ''' <summary>
  146. ''' 图标按钮,文件夹,1.15x
  147. ''' </summary>
  148. Public Const IconButtonOpen As String = "M889.018182 418.909091H884.363636V316.509091a93.090909 93.090909 0 0 0-99.607272-89.832727h-302.545455l-93.090909-76.334546A46.545455 46.545455 0 0 0 358.865455 139.636364H146.152727A93.090909 93.090909 0 0 0 46.545455 229.469091V837.818182a46.545455 46.545455 0 0 0 46.545454 46.545454 46.545455 46.545455 0 0 0 16.756364-3.258181 109.381818 109.381818 0 0 0 25.134545 3.258181h586.472727a85.178182 85.178182 0 0 0 87.04-63.301818l163.374546-302.545454a46.545455 46.545455 0 0 0 5.585454-21.876364A82.385455 82.385455 0 0 0 889.018182 418.909091z m-744.727273-186.181818h198.283636l93.09091 76.334545a46.545455 46.545455 0 0 0 29.323636 10.705455h319.301818a12.101818 12.101818 0 0 1 6.516364 0V418.909091H302.545455a85.178182 85.178182 0 0 0-87.04 63.301818L139.636364 622.778182V232.727273a19.549091 19.549091 0 0 1 6.516363 0z m578.094546 552.029091a27.461818 27.461818 0 0 0-2.792728 6.516363H154.530909l147.083636-272.290909a27.461818 27.461818 0 0 0 2.792728-6.981818h565.061818z"
  149. ''' <summary>
  150. ''' 图标按钮,名片,1.1x
  151. ''' </summary>
  152. Public Const IconButtonCard As String = "M834.5 684.1c-31.2-70.4-98.9-120.9-179.1-127.3 63.5-8.5 112.6-63 112.6-128.8 0-71.8-58.2-130-130-130s-130 58.2-130 130c0 65.9 49 120.3 112.6 128.8-80.2 6.4-148 57-179.1 127.3-8.7 19.7 6 42 27.6 42 12.1 0 22.7-7.5 27.7-18.5 24.3-53.9 78.5-91.5 141.3-91.5s117 37.6 141.3 91.5c5 11.1 15.6 18.5 27.7 18.5 21.4 0 36.1-22.3 27.4-42zM567.9 427.9c0-38.6 31.4-70 70-70s70 31.4 70 70-31.4 70-70 70-70-31.4-70-70zM460.3 347.9H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h243.3c16.6 0 30-13.4 30-30 0.1-16.5-13.4-30-29.9-30zM367.4 459.6H216.9c-16.6 0-30 13.4-30 30s13.4 30 30 30h150.4c16.6 0 30-13.4 30-30 0.1-16.6-13.4-30-29.9-30zM297.4 571.2H217c-16.6 0-30 13.4-30 30s13.4 30 30 30h80.4c16.6 0 30-13.4 30-30 0-16.5-13.5-30-30-30zM900 236v552H124V236h776m0-60H124c-33.1 0-60 26.9-60 60v552c0 33.1 26.9 60 60 60h776c33.1 0 60-26.9 60-60V236c0-33.1-26.9-60-60-60z"
  153. ''' <summary>
  154. ''' 图标按钮,×,0.85x
  155. ''' </summary>
  156. Public Const IconButtonCross As String = "F1 M 26.9166,22.1667L 37.9999,33.25L 49.0832,22.1668L 53.8332,26.9168L 42.7499,38L 53.8332,49.0834L 49.0833,53.8334L 37.9999,42.75L 26.9166,53.8334L 22.1666,49.0833L 33.25,38L 22.1667,26.9167L 26.9166,22.1667 Z"
  157. ''' <summary>
  158. ''' 图标按钮,Mojang,1.1x
  159. ''' </summary>
  160. Public Const IconButtonMojang As String = "M9.183,18.967c-0.109-2.239,1.336-5.119,3.92-4.96c3.657-0.027,7.319-0.044,10.977,0.005 c3.712,0.214,6.596,2.759,9.652,4.533c0.181-1.697-0.197-3.717,1.237-4.982c1.899,2.091,3.143,4.894,5.677,6.334 c1.577,0.805,2.973-0.668,4.221-1.44c1.55,2.305,2.108,5.075,2.622,7.752c0.657,3.438,0.947,6.925,1.111,10.413 c-1.734-0.733-3.355-1.708-4.971-2.671c-1.396-4.933-5.349-8.656-9.723-11.059c-3.46-1.817-7.752-2.185-11.338-0.52 c-3.761,1.593-6.285,5.666-5.891,9.75c0.121,4.577,3.17,8.765,7.391,10.456c7.746,3.285,16.407,2.234,24.521,1.243 c0.454,2.315-1.511,4.527-3.695,4.889c-10.577,0.038-21.148-0.011-31.725,0.022c-2.217,0.279-4.079-1.879-3.964-4.008 C9.167,36.141,9.216,27.556,9.183,18.967z M40.114,8.09c0.294-0.801,0.872-1.417,1.542-1.924c1.379,2.589,2.742,5.482,2.311,8.491 c-0.332,2.54-4.42,2.507-5.052,0.163C38.349,12.527,39.209,10.178,40.114,8.09z M0,53 l0.1,0 z"
  161. ''' <summary>
  162. ''' 图标按钮,用户,0.95x
  163. ''' </summary>
  164. Public Const IconButtonUser As String = "M660.338 528.065c63.61-46.825 105.131-121.964 105.131-206.83 0-141.7-115.29-256.987-256.997-256.987-141.706 0-256.998 115.288-256.998 256.987 0 85.901 42.52 161.887 107.456 208.562-152.1 59.92-260.185 207.961-260.185 381.077 0 21.276 17.253 38.53 38.53 38.53 21.278 0 38.53-17.254 38.53-38.53 0-183.426 149.232-332.671 332.667-332.671 1.589 0 3.113-0.207 4.694-0.244 0.8 0.056 1.553 0.244 2.362 0.244 183.434 0 332.664 149.245 332.664 332.671 0 21.276 17.255 38.53 38.533 38.53 21.277 0 38.53-17.254 38.53-38.53 0-174.885-110.354-324.13-264.917-382.809z m-331.803-206.83c0-99.22 80.72-179.927 179.935-179.927s179.937 80.708 179.937 179.927c0 99.203-80.721 179.91-179.937 179.91s-179.935-80.708-179.935-179.91z"
  165. ''' <summary>
  166. ''' 图标按钮,盾牌,1x
  167. ''' </summary>
  168. Public Const IconButtonShield As String = "M511.488256 95.184408c35.310345 22.516742 95.184408 55.78011 167.34033 84.437781 75.738131 29.681159 148.405797 40.93953 191.392304 45.033483v353.615193c0 73.691154-50.662669 164.781609-136.123938 244.101949C649.65917 901.181409 558.568716 942.12094 512 942.12094c-46.568716 0-137.65917-40.93953-222.096952-119.748126C204.441779 742.54073 153.77911 651.450275 153.77911 577.247376v-353.103448c42.474763-4.093953 116.165917-15.352324 191.904048-45.545227 75.226387-30.192904 133.565217-63.456272 165.805098-83.414293M512 0c-4.093953 0-8.187906 1.535232-11.258371 3.582209l-14.84058 10.234882c-1.023488 0.511744-67.550225 47.592204-170.410794 88.531735-100.813593 39.916042-198.556722 41.963018-199.58021 41.963018l-25.075462 0.511744c-10.746627 0.511744-18.934533 8.187906-18.934533 18.422789v414.000999c0 216.97951 286.064968 446.24088 440.09995 446.24088s440.09995-229.261369 440.09995-445.729136V163.758121c0-10.234883-8.69965-18.422789-18.934533-18.422789l-24.563718-0.511744c-1.023488 0-98.766617-2.046977-199.58021-41.963018-103.372314-40.93953-170.410795-88.01999-170.922538-88.531734L523.258371 3.582209c-3.070465-2.558721-7.164418-3.582209-11.258371-3.582209z M743.308346 410.930535l-260.477761 260.477761c-15.864068 15.864068-41.963018 15.864068-57.827087 0l-144.823588-144.823588c-15.864068-15.864068-15.864068-41.963018 0-57.827087 8.187906-8.187906 18.422789-11.770115 29.169415-11.770115 10.234883 0 20.981509 4.093953 29.169416 11.770115l115.654173 115.654173L685.993003 352.591704c15.864068-15.864068 41.963018-15.864068 57.827087 0 15.352324 16.375812 15.352324 42.474763-0.511744 58.338831z"
  169. ''' <summary>
  170. ''' 图标按钮,离线,0.85x
  171. ''' </summary>
  172. Public Const IconButtonOffline As String = "M533.293176 788.841412a60.235294 60.235294 0 1 1 85.202824 85.202823l-42.616471 42.586353c-129.355294 129.385412-339.124706 129.385412-468.510117 0-129.385412-129.385412-129.385412-339.124706 0-468.510117l42.586353-42.616471a60.235294 60.235294 0 1 1 85.202823 85.202824l-42.61647 42.586352a210.823529 210.823529 0 1 0 298.164706 298.164706l42.586352-42.61647z m255.548236-255.548236l42.61647-42.586352a210.823529 210.823529 0 1 0-298.164706-298.164706l-42.586352 42.61647a60.235294 60.235294 0 1 1-85.202824-85.202823l42.616471-42.586353c129.355294-129.385412 339.124706-129.385412 468.510117 0 129.385412 129.385412 129.385412 339.124706 0 468.510117l-42.586353 42.616471a60.235294 60.235294 0 1 1-85.202823-85.202824zM192.542118 192.542118a60.235294 60.235294 0 0 1 85.202823 0l553.712941 553.712941a60.235294 60.235294 0 0 1-85.202823 85.202823L192.542118 277.744941a60.235294 60.235294 0 0 1 0-85.202823z"
  173. ''' <summary>
  174. ''' 图标,服务端,1x
  175. ''' </summary>
  176. Public Const IconButtonServer As String = "M224 160a64 64 0 0 0-64 64v576a64 64 0 0 0 64 64h576a64 64 0 0 0 64-64V224a64 64 0 0 0-64-64H224z m0 384h576v256H224v-256z m192 96v64h320v-64H416z m-128 0v64h64v-64H288zM224 224h576v256H224V224z m192 96v64h320v-64H416z m-128 0v64h64v-64H288z"
  177. ''' <summary>
  178. ''' 图标,音符,1x
  179. ''' </summary>
  180. Public Const IconMusic As String = "M348.293565 716.53287V254.797913c0-41.672348 28.004174-78.358261 68.919652-90.37913L815.994435 40.826435c62.775652-18.610087 125.907478 26.579478 125.907478 89.933913v539.158261c8.013913 42.25113-8.94887 89.177043-47.014956 127.109565a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c21.014261 1.024 40.514783 5.164522 57.878261 12.065391V233.338435c0-12.109913-10.551652-20.034783-20.569044-20.034783a24.620522 24.620522 0 0 0-5.787826 0.934957L439.785739 338.18713a19.545043 19.545043 0 0 0-14.825739 19.144348v438.984348H423.846957c11.53113 43.987478-5.164522 94.208-45.412174 134.322087a232.848696 232.848696 0 0 1-170.785392 65.758609c-61.885217-2.938435-111.081739-33.435826-129.113043-80.050087-18.031304-46.614261-2.137043-102.177391 41.672348-145.853218a232.848696 232.848696 0 0 1 170.785391-65.80313c20.791652 1.024 40.069565 5.075478 57.299478 11.842783z"
  181. ''' <summary>
  182. ''' 图标,播放,0.8x
  183. ''' </summary>
  184. Public Const IconPlay As String = "M803.904 463.936a55.168 55.168 0 0 1 0 96.128l-463.616 264.448C302.848 845.888 256 819.136 256 776.448V247.616c0-42.752 46.848-69.44 84.288-48.064l463.616 264.384z"
  185. End Class
  186. #End Region
  187. #Region "自定义类"
  188. ''' <summary>
  189. ''' 支持小数与常见类型隐式转换的颜色。
  190. ''' </summary>
  191. Public Class MyColor
  192. Public A As Double = 255
  193. Public R As Double = 0
  194. Public G As Double = 0
  195. Public B As Double = 0
  196. '类型转换
  197. Public Shared Widening Operator CType(str As String) As MyColor
  198. Return New MyColor(str)
  199. End Operator
  200. Public Shared Widening Operator CType(col As Color) As MyColor
  201. Return New MyColor(col)
  202. End Operator
  203. Public Shared Widening Operator CType(conv As MyColor) As Color
  204. Return Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B))
  205. End Operator
  206. Public Shared Widening Operator CType(conv As MyColor) As System.Drawing.Color
  207. Return System.Drawing.Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B))
  208. End Operator
  209. Public Shared Widening Operator CType(bru As SolidColorBrush) As MyColor
  210. Return New MyColor(bru.Color)
  211. End Operator
  212. Public Shared Widening Operator CType(conv As MyColor) As SolidColorBrush
  213. Return New SolidColorBrush(Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B)))
  214. End Operator
  215. Public Shared Widening Operator CType(bru As Brush) As MyColor
  216. Return New MyColor(bru)
  217. End Operator
  218. Public Shared Widening Operator CType(conv As MyColor) As Brush
  219. Return New SolidColorBrush(Color.FromArgb(MathByte(conv.A), MathByte(conv.R), MathByte(conv.G), MathByte(conv.B)))
  220. End Operator
  221. '颜色运算
  222. Public Shared Operator +(a As MyColor, b As MyColor) As MyColor
  223. Return New MyColor With {.A = a.A + b.A, .B = a.B + b.B, .G = a.G + b.G, .R = a.R + b.R}
  224. End Operator
  225. Public Shared Operator -(a As MyColor, b As MyColor) As MyColor
  226. Return New MyColor With {.A = a.A - b.A, .B = a.B - b.B, .G = a.G - b.G, .R = a.R - b.R}
  227. End Operator
  228. Public Shared Operator *(a As MyColor, b As Double) As MyColor
  229. Return New MyColor With {.A = a.A * b, .B = a.B * b, .G = a.G * b, .R = a.R * b}
  230. End Operator
  231. Public Shared Operator /(a As MyColor, b As Double) As MyColor
  232. Return New MyColor With {.A = a.A / b, .B = a.B / b, .G = a.G / b, .R = a.R / b}
  233. End Operator
  234. Public Shared Operator =(a As MyColor, b As MyColor) As Boolean
  235. If IsNothing(a) AndAlso IsNothing(b) Then Return True
  236. If IsNothing(a) OrElse IsNothing(b) Then Return False
  237. Return a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B
  238. End Operator
  239. Public Shared Operator <>(a As MyColor, b As MyColor) As Boolean
  240. If IsNothing(a) AndAlso IsNothing(b) Then Return False
  241. If IsNothing(a) OrElse IsNothing(b) Then Return True
  242. Return Not (a.A = b.A AndAlso a.R = b.R AndAlso a.G = b.G AndAlso a.B = b.B)
  243. End Operator
  244. '构造函数
  245. Public Sub New()
  246. End Sub
  247. Public Sub New(col As Color)
  248. Me.A = col.A
  249. Me.R = col.R
  250. Me.G = col.G
  251. Me.B = col.B
  252. End Sub
  253. Public Sub New(HexString As String)
  254. Dim StringColor As Media.Color = ColorConverter.ConvertFromString(HexString)
  255. A = StringColor.A
  256. R = StringColor.R
  257. G = StringColor.G
  258. B = StringColor.B
  259. End Sub
  260. Public Sub New(newA As Double, col As MyColor)
  261. Me.A = newA
  262. Me.R = col.R
  263. Me.G = col.G
  264. Me.B = col.B
  265. End Sub
  266. Public Sub New(newR As Double, newG As Double, newB As Double)
  267. Me.A = 255
  268. Me.R = newR
  269. Me.G = newG
  270. Me.B = newB
  271. End Sub
  272. Public Sub New(newA As Double, newR As Double, newG As Double, newB As Double)
  273. Me.A = newA
  274. Me.R = newR
  275. Me.G = newG
  276. Me.B = newB
  277. End Sub
  278. Public Sub New(brush As Brush)
  279. Dim Color As Color = CType(brush, SolidColorBrush).Color
  280. A = Color.A
  281. R = Color.R
  282. G = Color.G
  283. B = Color.B
  284. End Sub
  285. Public Sub New(brush As SolidColorBrush)
  286. Dim Color As Color = brush.Color
  287. A = Color.A
  288. R = Color.R
  289. G = Color.G
  290. B = Color.B
  291. End Sub
  292. Public Sub New(obj As Object)
  293. If obj Is Nothing Then
  294. A = 255 : R = 255 : G = 255 : B = 255
  295. Else
  296. If TypeOf obj Is SolidColorBrush Then
  297. '避免反复获取 Color 对象造成性能下降
  298. Dim Color As Color = CType(obj, SolidColorBrush).Color
  299. A = Color.A
  300. R = Color.R
  301. G = Color.G
  302. B = Color.B
  303. Else
  304. A = obj.A
  305. R = obj.R
  306. G = obj.G
  307. B = obj.B
  308. End If
  309. End If
  310. End Sub
  311. 'HSL
  312. Public Function Hue(v1 As Double, v2 As Double, vH As Double) As Double
  313. If vH < 0 Then vH += 1
  314. If vH > 1 Then vH -= 1
  315. If vH < 0.16667 Then Return v1 + (v2 - v1) * 6 * vH
  316. If vH < 0.5 Then Return v2
  317. If vH < 0.66667 Then Return v1 + (v2 - v1) * (4 - vH * 6)
  318. Return v1
  319. End Function
  320. Public Function FromHSL(sH As Double, sS As Double, sL As Double) As MyColor
  321. If sS = 0 Then
  322. R = sL * 2.55
  323. G = R
  324. B = R
  325. Else
  326. Dim H = sH / 360
  327. Dim S = sS / 100
  328. Dim L = sL / 100
  329. S = If(L < 0.5, S * L + L, S * (1.0 - L) + L)
  330. L = 2 * L - S
  331. R = 255 * Hue(L, S, H + 1 / 3)
  332. G = 255 * Hue(L, S, H)
  333. B = 255 * Hue(L, S, H - 1 / 3)
  334. End If
  335. A = 255
  336. Return Me
  337. End Function
  338. Public Function FromHSL2(sH As Double, sS As Double, sL As Double) As MyColor
  339. If sS = 0 Then
  340. R = sL * 2.55 : G = R : B = R
  341. Else
  342. '初始化
  343. sH = (sH + 3600000) Mod 360
  344. Dim cent As Double() = {
  345. +0.1, -0.06, -0.3, '0, 30, 60
  346. -0.19, -0.15, -0.24, '90, 120, 150
  347. -0.32, -0.09, +0.18, '180, 210, 240
  348. +0.05, -0.12, -0.02, '270, 300, 330
  349. +0.1, -0.06} '最后两位与前两位一致,加是变亮,减是变暗
  350. '计算色调对应的亮度片区
  351. Dim center As Double = sH / 30.0
  352. Dim intCenter As Integer = Math.Floor(center) '亮度片区编号
  353. center = 50 - (
  354. (1 - center + intCenter) * cent(intCenter) + (center - intCenter) * cent(intCenter + 1)
  355. ) * sS
  356. 'center = 50 + (cent(intCenter) + (center - intCenter) * (cent(intCenter + 1) - cent(intCenter))) * sS
  357. sL = If(sL < center, sL / center, 1 + (sL - center) / (100 - center)) * 50
  358. FromHSL(sH, sS, sL)
  359. End If
  360. A = 255
  361. Return Me
  362. End Function
  363. Public Overrides Function ToString() As String
  364. Return "(" & A & "," & R & "," & G & "," & B & ")"
  365. End Function
  366. Public Overrides Function Equals(obj As Object) As Boolean
  367. Return Me = obj
  368. End Function
  369. End Class
  370. ''' <summary>
  371. ''' 支持负数与浮点数的矩形。
  372. ''' </summary>
  373. Public Class MyRect
  374. '属性
  375. Public Property Width As Double = 0
  376. Public Property Height As Double = 0
  377. Public Property Left As Double = 0
  378. Public Property Top As Double = 0
  379. '构造函数
  380. Public Sub New()
  381. End Sub
  382. Public Sub New(left As Double, top As Double, width As Double, height As Double)
  383. Me.Left = left
  384. Me.Top = top
  385. Me.Width = width
  386. Me.Height = height
  387. End Sub
  388. End Class
  389. ''' <summary>
  390. ''' 模块加载状态枚举。
  391. ''' </summary>
  392. Public Enum LoadState
  393. Waiting
  394. Loading
  395. Finished
  396. Failed
  397. Aborted
  398. End Enum
  399. ''' <summary>
  400. ''' 执行返回值。
  401. ''' </summary>
  402. Public Enum ProcessReturnValues
  403. ''' <summary>
  404. ''' 执行成功,或进程被中断。
  405. ''' </summary>
  406. Aborted = -1
  407. ''' <summary>
  408. ''' 执行成功。
  409. ''' </summary>
  410. Success = 0
  411. ''' <summary>
  412. ''' 执行失败。
  413. ''' </summary>
  414. Fail = 1
  415. ''' <summary>
  416. ''' 执行时出现未经处理的异常。
  417. ''' </summary>
  418. Exception = 2
  419. ''' <summary>
  420. ''' 执行超时。
  421. ''' </summary>
  422. Timeout = 3
  423. ''' <summary>
  424. ''' 取消执行。可能是由于不满足执行的前置条件。
  425. ''' </summary>
  426. Cancel = 4
  427. ''' <summary>
  428. ''' 任务成功完成。
  429. ''' </summary>
  430. TaskDone = 5
  431. End Enum
  432. ''' <summary>
  433. ''' 可以使用 Equals 和等号的 List。
  434. ''' </summary>
  435. Public Class EqualableList(Of T)
  436. Inherits List(Of T)
  437. Public Overrides Function Equals(obj As Object) As Boolean
  438. If TryCast(obj, List(Of T)) Is Nothing Then
  439. '类型不同
  440. Return False
  441. Else
  442. '类型相同
  443. Dim objList As List(Of T) = obj
  444. If objList.Count <> Count Then Return False
  445. For i = 0 To objList.Count - 1
  446. If Not objList(i).Equals(Me(i)) Then Return False
  447. Next
  448. Return True
  449. End If
  450. End Function
  451. Public Shared Operator =(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
  452. Return EqualityComparer(Of EqualableList(Of T)).Default.Equals(left, right)
  453. End Operator
  454. Public Shared Operator <>(left As EqualableList(Of T), right As EqualableList(Of T)) As Boolean
  455. Return Not left = right
  456. End Operator
  457. End Class
  458. #End Region
  459. #Region "数学"
  460. ''' <summary>
  461. ''' 2~65 进制的转换。
  462. ''' </summary>
  463. Public Function RadixConvert(Input As String, FromRadix As Integer, ToRadix As Integer) As String
  464. Const Digits As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz/+="
  465. '零与负数的处理
  466. If String.IsNullOrEmpty(Input) Then Return "0"
  467. Dim IsNegative As Boolean = Input.StartsWithF("-")
  468. If IsNegative Then Input = Input.TrimStart("-")
  469. '转换为十进制
  470. Dim RealNum As Long = 0, Scale As Long = 1
  471. For Each Digit In Input.Reverse.Select(Function(l) Digits.IndexOfF(l))
  472. RealNum += Digit * Scale
  473. Scale *= FromRadix
  474. Next
  475. If RealNum = 0 Then Return "0"
  476. '转换为指定进制
  477. Dim Result = ""
  478. While RealNum > 0
  479. Dim NewNum As Integer = RealNum Mod ToRadix
  480. RealNum = (RealNum - NewNum) / ToRadix
  481. Result = Digits(NewNum) & Result
  482. End While
  483. '负数的结束处理与返回
  484. Return If(IsNegative, "-", "") & Result
  485. End Function
  486. ''' <summary>
  487. ''' 计算二阶贝塞尔曲线。
  488. ''' </summary>
  489. Public Function MathBezier(x As Double, x1 As Double, y1 As Double, x2 As Double, y2 As Double, Optional acc As Double = 0.01) As Double
  490. If x <= 0 OrElse Double.IsNaN(x) Then Return 0
  491. If x >= 1 Then Return 1
  492. Dim a, b
  493. a = x
  494. Do
  495. b = 3 * a * ((0.33333333 + x1 - x2) * a * a + (x2 - 2 * x1) * a + x1)
  496. a += (x - b) * 0.5
  497. Loop Until Math.Abs(b - x) < acc '精度
  498. Return 3 * a * ((0.33333333 + y1 - y2) * a * a + (y2 - 2 * y1) * a + y1)
  499. End Function
  500. ''' <summary>
  501. ''' 将一个数字限制为 0~255 的 Byte 值。
  502. ''' </summary>
  503. Public Function MathByte(d As Double) As Byte
  504. If d < 0 Then d = 0
  505. If d > 255 Then d = 255
  506. Return Math.Round(d)
  507. End Function
  508. ''' <summary>
  509. ''' 提供 MyColor 类型支持的 Math.Round。
  510. ''' </summary>
  511. Public Function MathRound(col As MyColor, Optional w As Integer = 0) As MyColor
  512. Return New MyColor With {.A = Math.Round(col.A, w), .R = Math.Round(col.R, w), .G = Math.Round(col.G, w), .B = Math.Round(col.B, w)}
  513. End Function
  514. ''' <summary>
  515. ''' 获取两数间的百分比。小数点精确到 6 位。
  516. ''' </summary>
  517. ''' <returns></returns>
  518. Public Function MathPercent(ValueA As Double, ValueB As Double, Percent As Double) As Double
  519. Return Math.Round(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决 Double 计算错误
  520. End Function
  521. ''' <summary>
  522. ''' 获取两颜色间的百分比,根据 RGB 计算。小数点精确到 6 位。
  523. ''' </summary>
  524. Public Function MathPercent(ValueA As MyColor, ValueB As MyColor, Percent As Double) As MyColor
  525. Return MathRound(ValueA * (1 - Percent) + ValueB * Percent, 6) '解决Double计算错误
  526. End Function
  527. ''' <summary>
  528. ''' 将数值限定在某个范围内。
  529. ''' </summary>
  530. Public Function MathClamp(value As Double, min As Double, max As Double) As Double
  531. Return Math.Max(min, Math.Min(max, value))
  532. End Function
  533. ''' <summary>
  534. ''' 符号函数。
  535. ''' </summary>
  536. Public Function MathSgn(Value As Double) As Integer
  537. If Value = 0 Then
  538. Return 0
  539. ElseIf Value > 0 Then
  540. Return 1
  541. Else
  542. Return -1
  543. End If
  544. End Function
  545. #End Region
  546. #Region "文件"
  547. '=============================
  548. ' 注册表
  549. '=============================
  550. ''' <summary>
  551. ''' 读取注册表键。如果失败则返回默认值。
  552. ''' </summary>
  553. Public Function ReadReg(Key As String, Optional DefaultValue As String = "") As String
  554. Try
  555. Return If(My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, False)?.GetValue(Key), DefaultValue)
  556. Catch ex As Exception
  557. Log(ex, "读取注册表出错:" & Key, LogLevel.Hint)
  558. Return DefaultValue
  559. End Try
  560. End Function
  561. ''' <summary>
  562. ''' 写入注册表键。
  563. ''' </summary>
  564. Public Sub WriteReg(Key As String, Value As String, Optional ThrowException As Boolean = False)
  565. Try
  566. Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
  567. If SubKey Is Nothing Then SubKey = My.Computer.Registry.CurrentUser.CreateSubKey("Software\" & RegFolder) '如果不存在就创建
  568. SubKey.SetValue(Key, Value)
  569. Catch ex As Exception
  570. Log(ex, "写入注册表出错:" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer))
  571. If ThrowException Then Throw
  572. End Try
  573. End Sub
  574. ''' <summary>
  575. ''' 是否存在某个注册表键。
  576. ''' </summary>
  577. Public Function HasReg(Key As String) As Boolean
  578. Return ReadReg(Key, Nothing) IsNot Nothing
  579. End Function
  580. ''' <summary>
  581. ''' 删除注册表键。
  582. ''' </summary>
  583. Public Sub DeleteReg(Key As String, Optional ThrowException As Boolean = False)
  584. Try
  585. Dim SubKey As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Software\" & RegFolder, True)
  586. SubKey?.DeleteValue(Key)
  587. Catch ex As Exception
  588. Log(ex, "删除注册表出错:" & Key, If(ThrowException, LogLevel.Hint, LogLevel.Developer))
  589. If ThrowException Then Throw
  590. End Try
  591. End Sub
  592. '=============================
  593. ' ini
  594. '=============================
  595. Private ReadOnly IniCache As New SafeDictionary(Of String, SafeDictionary(Of String, String))
  596. ''' <summary>
  597. ''' 清除某 ini 文件的运行时缓存。
  598. ''' </summary>
  599. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  600. Public Sub IniClearCache(FileName As String)
  601. If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
  602. If IniCache.ContainsKey(FileName) Then IniCache.Remove(FileName)
  603. End Sub
  604. ''' <summary>
  605. ''' 获取 ini 文件缓存。如果没有,则新读取 ini 文件内容。
  606. ''' 在文件不存在或读取失败时返回 Nothing。
  607. ''' </summary>
  608. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  609. Private Function IniGetContent(FileName As String) As SafeDictionary(Of String, String)
  610. Try
  611. '还原文件路径
  612. If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
  613. '检索缓存
  614. If IniCache.ContainsKey(FileName) Then Return IniCache(FileName)
  615. '读取文件
  616. If Not File.Exists(FileName) Then Return Nothing
  617. Dim Ini As New SafeDictionary(Of String, String)
  618. For Each Line In ReadFile(FileName).Split(vbCrLf.ToArray(), StringSplitOptions.RemoveEmptyEntries)
  619. Dim Index As Integer = Line.IndexOfF(":")
  620. If Index > 0 Then Ini(Line.Substring(0, Index)) = Line.Substring(Index + 1) '可能会有重复键,见 #3616
  621. Next
  622. IniCache(FileName) = Ini
  623. Return Ini
  624. Catch ex As Exception
  625. Log(ex, $"生成 ini 文件缓存失败({FileName})", LogLevel.Hint)
  626. Return Nothing
  627. End Try
  628. End Function
  629. ''' <summary>
  630. ''' 读取 ini 文件。这可能会使用到缓存。
  631. ''' </summary>
  632. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  633. ''' <param name="Key">键。</param>
  634. ''' <param name="DefaultValue">没有找到键时返回的默认值。</param>
  635. Public Function ReadIni(FileName As String, Key As String, Optional DefaultValue As String = "") As String
  636. Dim Content = IniGetContent(FileName)
  637. If Content Is Nothing OrElse Not Content.ContainsKey(Key) Then Return DefaultValue
  638. Return Content(Key)
  639. End Function
  640. ''' <summary>
  641. ''' 判断 ini 文件中是否包含某个键。这可能会使用到缓存。
  642. ''' </summary>
  643. Public Function HasIniKey(FileName As String, Key As String) As Boolean
  644. Dim Content = IniGetContent(FileName)
  645. Return Content IsNot Nothing AndAlso Content.ContainsKey(Key)
  646. End Function
  647. ''' <summary>
  648. ''' 从 ini 文件中移除某个键。这会更新缓存。
  649. ''' </summary>
  650. Public Sub DeleteIniKey(FileName As String, Key As String)
  651. WriteIni(FileName, Key, Nothing)
  652. End Sub
  653. ''' <summary>
  654. ''' 写入 ini 文件,这会更新缓存。
  655. ''' 若 Value 为 Nothing,则删除该键。
  656. ''' </summary>
  657. ''' <param name="FileName">文件完整路径或简写文件名。简写将会使用“ApplicationName\文件名.ini”作为路径。</param>
  658. ''' <param name="Key">键。</param>
  659. ''' <param name="Value">值。</param>
  660. ''' <remarks></remarks>
  661. Public Sub WriteIni(FileName As String, Key As String, Value As String)
  662. Try
  663. '预处理
  664. If Key.Contains(":") Then Throw New Exception($"尝试写入 ini 文件 {FileName} 的键名中包含了冒号:{Key}")
  665. Key = Key.Replace(vbCr, "").Replace(vbLf, "")
  666. Value = Value?.Replace(vbCr, "").Replace(vbLf, "")
  667. '防止争用
  668. SyncLock WriteIniLock
  669. '获取目前文件
  670. Dim Content As SafeDictionary(Of String, String) = IniGetContent(FileName)
  671. If Content Is Nothing Then Content = New SafeDictionary(Of String, String)
  672. '更新值
  673. If Value Is Nothing Then
  674. If Not Content.ContainsKey(Key) Then Return '无需处理
  675. Content.Remove(Key)
  676. Else
  677. If Content.ContainsKey(Key) AndAlso Content(Key) = Value Then Return '无需处理
  678. Content(Key) = Value
  679. End If
  680. '写入文件
  681. Dim FileContent As New StringBuilder
  682. For Each Pair In Content
  683. FileContent.Append(Pair.Key)
  684. FileContent.Append(":")
  685. FileContent.Append(Pair.Value)
  686. FileContent.Append(vbCrLf)
  687. Next
  688. If Not FileName.Contains(":\") Then FileName = $"{Path}PCL\{FileName}.ini"
  689. WriteFile(FileName, FileContent.ToString)
  690. End SyncLock
  691. Catch ex As Exception
  692. Log(ex, $"写入文件失败({FileName} → {Key}:{Value})", LogLevel.Hint)
  693. End Try
  694. End Sub
  695. Private WriteIniLock As New Object
  696. '路径处理
  697. ''' <summary>
  698. ''' 从文件路径或者 Url 获取不包含文件名的路径,或获取文件夹的父文件夹路径。
  699. ''' 取决于原路径格式,路径以 / 或 \ 结尾。
  700. ''' 不包含路径将会抛出异常。
  701. ''' </summary>
  702. Public Function GetPathFromFullPath(FilePath As String) As String
  703. If Not (FilePath.Contains("\") OrElse FilePath.Contains("/")) Then Throw New Exception("不包含路径:" & FilePath)
  704. If FilePath.EndsWithF("\") OrElse FilePath.EndsWithF("/") Then
  705. '是文件夹路径
  706. Dim IsRight As Boolean = FilePath.EndsWithF("\")
  707. FilePath = Left(FilePath, Len(FilePath) - 1)
  708. GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"})) & If(IsRight, "\", "/")
  709. Else
  710. '是文件路径
  711. GetPathFromFullPath = Left(FilePath, FilePath.LastIndexOfAny({"\", "/"}) + 1)
  712. If GetPathFromFullPath = "" Then Throw New Exception("不包含路径:" & FilePath)
  713. End If
  714. End Function
  715. ''' <summary>
  716. ''' 从文件路径或者 Url 获取不包含路径的文件名。不包含文件名将会抛出异常。
  717. ''' </summary>
  718. Public Function GetFileNameFromPath(FilePath As String) As String
  719. FilePath = FilePath.Replace("/", "\")
  720. If FilePath.EndsWithF("\") Then Throw New Exception("不包含文件名:" & FilePath)
  721. If FilePath.Contains("?") Then FilePath = FilePath.Substring(0, FilePath.IndexOfF("?")) '去掉网络参数后的 ?
  722. If FilePath.Contains("\") Then FilePath = FilePath.Substring(FilePath.LastIndexOfF("\") + 1)
  723. Dim length As Integer = FilePath.Length
  724. If length = 0 Then Throw New Exception("不包含文件名:" & FilePath)
  725. Return FilePath
  726. End Function
  727. ''' <summary>
  728. ''' 从文件夹路径获取文件夹名。
  729. ''' </summary>
  730. Public Function GetFolderNameFromPath(FolderPath As String) As String
  731. If FolderPath.EndsWithF(":\") OrElse FolderPath.EndsWithF(":\\") Then Return FolderPath.Substring(0, 1)
  732. If FolderPath.EndsWithF("\") OrElse FolderPath.EndsWithF("/") Then FolderPath = Left(FolderPath, FolderPath.Length - 1)
  733. Return GetFileNameFromPath(FolderPath)
  734. End Function
  735. '读取、写入、复制文件
  736. ''' <summary>
  737. ''' 复制文件。会自动创建文件夹、会覆盖已有的文件。
  738. ''' </summary>
  739. Public Sub CopyFile(FromPath As String, ToPath As String)
  740. Try
  741. '还原文件路径
  742. FromPath = If(FromPath.Contains(":\"), FromPath, Path & FromPath)
  743. ToPath = If(ToPath.Contains(":\"), ToPath, Path & ToPath)
  744. '如果复制同一个文件则跳过
  745. If FromPath = ToPath Then Return
  746. '确保目录存在
  747. Directory.CreateDirectory(GetPathFromFullPath(ToPath))
  748. '复制文件
  749. File.Copy(FromPath, ToPath, True)
  750. Catch ex As Exception
  751. Throw New Exception("复制文件出错:" & FromPath & " → " & ToPath, ex)
  752. End Try
  753. End Sub
  754. ''' <summary>
  755. ''' 读取文件,如果失败则返回空数组。
  756. ''' </summary>
  757. Public Function ReadFileBytes(FilePath As String, Optional Encoding As Encoding = Nothing) As Byte()
  758. Try
  759. '还原文件路径
  760. If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
  761. If File.Exists(FilePath) Then
  762. Dim FileBytes As Byte()
  763. Using ReadStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite) '支持读取使用中的文件
  764. ReDim FileBytes(ReadStream.Length - 1)
  765. ReadStream.Read(FileBytes, 0, ReadStream.Length)
  766. End Using
  767. Return FileBytes
  768. Else
  769. Log("[System] 欲读取的文件不存在,已返回空内容:" & FilePath)
  770. Return {}
  771. End If
  772. Catch ex As Exception
  773. Log(ex, "读取文件出错:" & FilePath)
  774. Return {}
  775. End Try
  776. End Function
  777. ''' <summary>
  778. ''' 读取文件,如果失败则返回空字符串。
  779. ''' </summary>
  780. ''' <param name="FilePath">文件完整或相对路径。</param>
  781. Public Function ReadFile(FilePath As String, Optional Encoding As Encoding = Nothing) As String
  782. Dim FileBytes = ReadFileBytes(FilePath)
  783. ReadFile = If(Encoding Is Nothing, DecodeBytes(FileBytes), Encoding.GetString(FileBytes))
  784. End Function
  785. ''' <summary>
  786. ''' 读取流中的所有文本。
  787. ''' </summary>
  788. Public Function ReadFile(Stream As Stream, Optional Encoding As Encoding = Nothing) As String
  789. Try
  790. Dim srcBuf As Byte() = New Byte(16384) {}
  791. Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384)
  792. Dim Result As New List(Of Byte)
  793. While DataCount > 0
  794. If DataCount > 0 Then Result.AddRange(srcBuf.ToList.GetRange(0, DataCount))
  795. DataCount = Stream.Read(srcBuf, 0, 16384)
  796. End While
  797. Dim Bts = Result.ToArray
  798. Return If(Encoding, GetEncoding(Bts)).GetString(Bts)
  799. Catch ex As Exception
  800. Log(ex, "读取流出错")
  801. Return ""
  802. End Try
  803. End Function
  804. ''' <summary>
  805. ''' 写入文件。
  806. ''' </summary>
  807. ''' <param name="FilePath">文件完整或相对路径。</param>
  808. ''' <param name="Text">文件内容。</param>
  809. ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
  810. Public Sub WriteFile(FilePath As String, Text As String, Optional Append As Boolean = False, Optional Encoding As Encoding = Nothing)
  811. '处理相对路径
  812. FilePath = If(FilePath.Contains(":\"), FilePath, Path & FilePath)
  813. '确保目录存在
  814. Directory.CreateDirectory(GetPathFromFullPath(FilePath))
  815. '写入文件
  816. If Append Then
  817. '追加目前文件
  818. Using writer As New StreamWriter(FilePath, True, If(Encoding, GetEncoding(ReadFileBytes(FilePath))))
  819. writer.Write(Text)
  820. writer.Flush()
  821. writer.Close()
  822. End Using
  823. Else
  824. '直接写入字节
  825. File.WriteAllBytes(FilePath, If(Encoding Is Nothing, New UTF8Encoding(False).GetBytes(Text), Encoding.GetBytes(Text)))
  826. End If
  827. End Sub
  828. ''' <summary>
  829. ''' 写入文件。
  830. ''' 如果 CanThrow 设置为 False,返回是否写入成功。
  831. ''' </summary>
  832. ''' <param name="FilePath">文件完整或相对路径。</param>
  833. ''' <param name="Content">文件内容。</param>
  834. ''' <param name="Append">是否将文件内容追加到当前文件,而不是覆盖它。</param>
  835. Public Sub WriteFile(FilePath As String, Content As Byte(), Optional Append As Boolean = False)
  836. '处理相对路径
  837. FilePath = If(FilePath.Contains(":\"), FilePath, Path & FilePath)
  838. '确保目录存在
  839. Directory.CreateDirectory(GetPathFromFullPath(FilePath))
  840. '写入文件
  841. File.WriteAllBytes(FilePath, Content)
  842. End Sub
  843. ''' <summary>
  844. ''' 将流写入文件。
  845. ''' </summary>
  846. ''' <param name="FilePath">文件完整或相对路径。</param>
  847. Public Function WriteFile(FilePath As String, Stream As Stream) As Boolean
  848. Try
  849. '还原文件路径
  850. If Not FilePath.Contains(":\") Then FilePath = Path & FilePath
  851. '确保目录存在
  852. Directory.CreateDirectory(GetPathFromFullPath(FilePath))
  853. '读取流
  854. Using fs As New FileStream(FilePath, FileMode.Create, FileAccess.Write)
  855. Dim srcBuf As Byte() = New Byte(16384) {}
  856. Dim DataCount As Integer = Stream.Read(srcBuf, 0, 16384)
  857. While DataCount > 0
  858. If DataCount > 0 Then fs.Write(srcBuf, 0, DataCount)
  859. DataCount = Stream.Read(srcBuf, 0, 16384)
  860. End While
  861. fs.Close()
  862. End Using
  863. Return True
  864. Catch ex As Exception
  865. Log(ex, "保存流出错")
  866. Return False
  867. End Try
  868. End Function
  869. '文件编码
  870. ''' <summary>
  871. ''' 根据字节数组分析其编码。
  872. ''' </summary>
  873. Public Function GetEncoding(Bytes As Byte()) As Encoding
  874. Dim Length As Integer = Bytes.Count
  875. If Length < 3 Then Return New UTF8Encoding(False) '不带 BOM 的 UTF8
  876. '根据 BOM 判断编码
  877. If Bytes(0) >= &HEF Then
  878. '有 BOM 类型
  879. If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
  880. Return New UTF8Encoding(True) '带 BOM 的 UTF8
  881. ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
  882. Return Encoding.BigEndianUnicode
  883. ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
  884. Return Encoding.Unicode
  885. Else
  886. Return Encoding.GetEncoding("GB18030")
  887. End If
  888. End If
  889. '无 BOM 文件:GB18030(ANSI)或 UTF8
  890. Dim UTF8 = Encoding.UTF8.GetString(Bytes)
  891. Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
  892. If UTF8.Contains(ErrorChar) Then
  893. Return Encoding.GetEncoding("GB18030")
  894. Else
  895. Return New UTF8Encoding(False) '不带 BOM 的 UTF8
  896. End If
  897. End Function
  898. ''' <summary>
  899. ''' 解码 Bytes。
  900. ''' </summary>
  901. Public Function DecodeBytes(Bytes As Byte()) As String
  902. Dim Length As Integer = Bytes.Length
  903. If Length < 3 Then Return Encoding.UTF8.GetString(Bytes)
  904. '根据 BOM 判断编码
  905. If Bytes(0) >= &HEF Then
  906. '有 BOM 类型
  907. If Bytes(0) = &HEF AndAlso Bytes(1) = &HBB Then
  908. Return Encoding.UTF8.GetString(Bytes, 3, Length - 3)
  909. ElseIf Bytes(0) = &HFE AndAlso Bytes(1) = &HFF Then
  910. Return Encoding.BigEndianUnicode.GetString(Bytes, 3, Length - 3)
  911. ElseIf Bytes(0) = &HFF AndAlso Bytes(1) = &HFE Then
  912. Return Encoding.Unicode.GetString(Bytes, 3, Length - 3)
  913. Else
  914. Return Encoding.GetEncoding("GB18030").GetString(Bytes, 3, Length - 3)
  915. End If
  916. End If
  917. '无 BOM 文件:GB18030(ANSI)或 UTF8
  918. Dim UTF8 = Encoding.UTF8.GetString(Bytes)
  919. Dim ErrorChar As Char = Encoding.UTF8.GetString({239, 191, 189}).ToCharArray()(0)
  920. If UTF8.Contains(ErrorChar) Then
  921. Return Encoding.GetEncoding("GB18030").GetString(Bytes)
  922. Else
  923. Return UTF8
  924. End If
  925. End Function
  926. '对话框
  927. ''' <summary>
  928. ''' 弹出保存对话框并且要求保存位置,返回用户输入的完整路径。
  929. ''' </summary>
  930. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  931. ''' <param name="Title">弹窗的标题。</param>
  932. ''' <param name="FileName">默认的文件名。</param>
  933. Public Function SelectSaveFile(Title As String, FileName As String, Optional FileFilter As String = Nothing, Optional InitialDirectory As String = Nothing) As String
  934. Using fileDialog As New Forms.SaveFileDialog
  935. fileDialog.AddExtension = True
  936. fileDialog.AutoUpgradeEnabled = True
  937. fileDialog.Title = Title
  938. fileDialog.FileName = FileName
  939. If FileFilter IsNot Nothing Then fileDialog.Filter = FileFilter
  940. If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
  941. fileDialog.ShowDialog()
  942. SelectSaveFile = If(fileDialog.FileName.Contains(":\"), fileDialog.FileName, "")
  943. Log("[UI] 选择文件返回:" & SelectSaveFile)
  944. End Using
  945. End Function
  946. ''' <summary>
  947. ''' 弹出选取文件对话框,要求选择一个文件。
  948. ''' </summary>
  949. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  950. ''' <param name="Title">弹窗的标题。</param>
  951. Public Function SelectFile(FileFilter As String, Title As String, Optional InitialDirectory As String = Nothing) As String
  952. Using fileDialog As New Forms.OpenFileDialog
  953. fileDialog.AddExtension = True
  954. fileDialog.AutoUpgradeEnabled = True
  955. fileDialog.CheckFileExists = True
  956. fileDialog.Filter = FileFilter
  957. fileDialog.Multiselect = False
  958. fileDialog.Title = Title
  959. fileDialog.ValidateNames = True
  960. If Not String.IsNullOrEmpty(InitialDirectory) AndAlso Directory.Exists(InitialDirectory) Then fileDialog.InitialDirectory = InitialDirectory
  961. fileDialog.ShowDialog()
  962. Log("[UI] 选择单个文件返回:" & fileDialog.FileName)
  963. Return fileDialog.FileName
  964. End Using
  965. End Function
  966. ''' <summary>
  967. ''' 弹出选取文件对话框,要求选择多个文件。
  968. ''' </summary>
  969. ''' <param name="FileFilter">要求的格式。如:“常用图片文件(*.png;*.jpg)|*.png;*.jpg”。</param>
  970. ''' <param name="Title">弹窗的标题。</param>
  971. Public Function SelectFiles(FileFilter As String, Title As String) As String()
  972. Using fileDialog As New Forms.OpenFileDialog
  973. fileDialog.AddExtension = True
  974. fileDialog.AutoUpgradeEnabled = True
  975. fileDialog.CheckFileExists = True
  976. fileDialog.Filter = FileFilter
  977. fileDialog.Multiselect = True
  978. fileDialog.Title = Title
  979. fileDialog.ValidateNames = True
  980. fileDialog.ShowDialog()
  981. Log("[UI] 选择多个文件返回:" & fileDialog.FileNames.Join(","))
  982. Return fileDialog.FileNames
  983. End Using
  984. End Function
  985. ''' <summary>
  986. ''' 弹出选取文件夹对话框,要求选取文件夹。
  987. ''' 返回以 \ 结尾的完整路径,如果没有选择则返回空字符串。
  988. ''' </summary>
  989. Public Function SelectFolder(Optional Title As String = "选择文件夹") As String
  990. Dim folderDialog As New Ookii.Dialogs.Wpf.VistaFolderBrowserDialog With {.ShowNewFolderButton = True, .RootFolder = Environment.SpecialFolder.Desktop, .Description = Title, .UseDescriptionForTitle = True}
  991. folderDialog.ShowDialog()
  992. SelectFolder = If(String.IsNullOrEmpty(folderDialog.SelectedPath), "", folderDialog.SelectedPath & If(folderDialog.SelectedPath.EndsWithF("\"), "", "\"))
  993. Log("[UI] 选择文件夹返回:" & SelectFolder)
  994. End Function
  995. '文件校验
  996. ''' <summary>
  997. ''' 检查是否拥有某一文件夹的 I/O 权限。如果文件夹不存在,会返回 False。
  998. ''' </summary>
  999. Public Function CheckPermission(Path As String) As Boolean
  1000. Try
  1001. If String.IsNullOrEmpty(Path) Then Return False
  1002. If Not Path.EndsWithF("\") Then Path += "\"
  1003. If Path.EndsWithF(":\System Volume Information\") OrElse Path.EndsWithF(":\$RECYCLE.BIN\") Then Return False
  1004. If Not Directory.Exists(Path) Then Return False
  1005. Dim FileName As String = "CheckPermission" & GetUuid()
  1006. If File.Exists(Path & FileName) Then File.Delete(Path & FileName)
  1007. File.Create(Path & FileName).Dispose()
  1008. File.Delete(Path & FileName)
  1009. Return True
  1010. Catch ex As Exception
  1011. Log(ex, "没有对文件夹 " & Path & " 的权限,请尝试以管理员权限运行 PCL")
  1012. Return False
  1013. End Try
  1014. End Function
  1015. ''' <summary>
  1016. ''' 检查是否拥有某一文件夹的 I/O 权限。如果出错,则抛出异常。
  1017. ''' </summary>
  1018. Public Sub CheckPermissionWithException(Path As String)
  1019. If String.IsNullOrWhiteSpace(Path) Then Throw New ArgumentNullException("文件夹名不能为空!")
  1020. If Not Path.EndsWithF("\") Then Path += "\"
  1021. If Not Directory.Exists(Path) Then Throw New DirectoryNotFoundException("文件夹不存在!")
  1022. If File.Exists(Path & "CheckPermission") Then File.Delete(Path & "CheckPermission")
  1023. File.Create(Path & "CheckPermission").Dispose()
  1024. File.Delete(Path & "CheckPermission")
  1025. End Sub
  1026. ''' <summary>
  1027. ''' 获取文件 MD5,若失败则返回空字符串。
  1028. ''' </summary>
  1029. Public Function GetFileMD5(FilePath As String) As String
  1030. Dim Retry As Boolean = False
  1031. Re:
  1032. Try
  1033. '获取 MD5
  1034. Using File As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1035. Using h = MD5Cng.Create()
  1036. Dim Retval As Byte() = h.ComputeHash(File)
  1037. Dim Result As New StringBuilder(Retval.Length * 2)
  1038. For i = 0 To Retval.Length - 1
  1039. Result.Append(Retval(i).ToString("x2"))
  1040. Next
  1041. Return Result.ToString
  1042. End Using
  1043. End Using
  1044. Catch ex As Exception
  1045. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1046. Log(ex, "获取文件 MD5 失败:" & FilePath)
  1047. Return ""
  1048. Else
  1049. Retry = True
  1050. Log(ex, "获取文件 MD5 可重试失败:" & FilePath, LogLevel.Normal)
  1051. Thread.Sleep(RandomInteger(200, 500))
  1052. GoTo Re
  1053. End If
  1054. End Try
  1055. End Function
  1056. ''' <summary>
  1057. ''' 获取文件 SHA512,若失败则返回空字符串。
  1058. ''' </summary>
  1059. Public Function GetFileSHA512(FilePath As String) As String
  1060. Dim Retry As Boolean = False
  1061. Re:
  1062. Try
  1063. ''检测该文件是否在下载中,若在下载则放弃检测
  1064. 'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
  1065. '获取 SHA512
  1066. Using file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1067. Using h = SHA512Cng.Create()
  1068. Dim retval As Byte() = h.ComputeHash(file)
  1069. Dim Result As New StringBuilder(retval.Length * 2)
  1070. For i As Integer = 0 To retval.Length - 1
  1071. Result.Append(retval(i).ToString("x2"))
  1072. Next
  1073. Return Result.ToString
  1074. End Using
  1075. End Using
  1076. Catch ex As Exception
  1077. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1078. Log(ex, "获取文件 SHA512 失败:" & FilePath)
  1079. Return ""
  1080. Else
  1081. Retry = True
  1082. Log(ex, "获取文件 SHA512 可重试失败:" & FilePath, LogLevel.Normal)
  1083. Thread.Sleep(RandomInteger(200, 500))
  1084. GoTo Re
  1085. End If
  1086. End Try
  1087. End Function
  1088. ''' <summary>
  1089. ''' 获取文件 SHA256,若失败则返回空字符串。
  1090. ''' </summary>
  1091. Public Function GetFileSHA256(FilePath As String) As String
  1092. Dim Retry As Boolean = False
  1093. Re:
  1094. Try
  1095. ''检测该文件是否在下载中,若在下载则放弃检测
  1096. 'If IgnoreOnDownloading AndAlso NetManage.Files.ContainsKey(FilePath) AndAlso NetManage.Files(FilePath).State <= NetState.Merge Then Return ""
  1097. '获取 SHA256
  1098. Using file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1099. Using h = SHA256Cng.Create()
  1100. Dim retval As Byte() = h.ComputeHash(file)
  1101. Dim Result As New StringBuilder(retval.Length * 2)
  1102. For i As Integer = 0 To retval.Length - 1
  1103. Result.Append(retval(i).ToString("x2"))
  1104. Next
  1105. Return Result.ToString()
  1106. End Using
  1107. End Using
  1108. Catch ex As Exception
  1109. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1110. Log(ex, "获取文件 SHA256 失败:" & FilePath)
  1111. Return ""
  1112. Else
  1113. Retry = True
  1114. Log(ex, "获取文件 SHA256 可重试失败:" & FilePath, LogLevel.Normal)
  1115. Thread.Sleep(RandomInteger(200, 500))
  1116. GoTo Re
  1117. End If
  1118. End Try
  1119. End Function
  1120. ''' <summary>
  1121. ''' 获取文件 SHA1,若失败则返回空字符串。
  1122. ''' </summary>
  1123. Public Function GetFileSHA1(FilePath As String) As String
  1124. Dim Retry As Boolean = False
  1125. Re:
  1126. Try
  1127. '获取 SHA1
  1128. Using file As New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
  1129. Using h = SHA1Cng.Create()
  1130. Dim retval As Byte() = h.ComputeHash(file)
  1131. Dim Result As New StringBuilder(retval.Length * 2)
  1132. For i As Integer = 0 To retval.Length - 1
  1133. Result.Append(retval(i).ToString("x2"))
  1134. Next
  1135. Return Result.ToString
  1136. End Using
  1137. End Using
  1138. Catch ex As Exception
  1139. If Retry OrElse TypeOf ex Is FileNotFoundException Then
  1140. Log(ex, "获取文件 SHA1 失败:" & FilePath)
  1141. Return ""
  1142. Else
  1143. Retry = True
  1144. Log(ex, "获取文件 SHA1 可重试失败:" & FilePath, LogLevel.Normal)
  1145. Thread.Sleep(RandomInteger(200, 500))
  1146. GoTo Re
  1147. End If
  1148. End Try
  1149. End Function
  1150. ''' <summary>
  1151. ''' 获取流的 SHA1,若失败则返回空字符串。
  1152. ''' </summary>
  1153. Public Function GetAuthSHA1(Stream As Stream) As String
  1154. Try
  1155. Dim sha1 As SHA1 = New SHA1CryptoServiceProvider()
  1156. Dim retval As Byte() = sha1.ComputeHash(Stream)
  1157. Dim Result As New StringBuilder()
  1158. For i As Integer = 0 To retval.Length - 1
  1159. Result.Append(retval(i).ToString("x2"))
  1160. Next
  1161. Return Result.ToString
  1162. Catch ex As Exception
  1163. Log(ex, "获取流 SHA1 失败")
  1164. Return ""
  1165. End Try
  1166. End Function
  1167. ''' <summary>
  1168. ''' 文件的校验规则。
  1169. ''' </summary>
  1170. Public Class FileChecker
  1171. ''' <summary>
  1172. ''' 文件的准确大小。
  1173. ''' 不检查则为 -1。
  1174. ''' </summary>
  1175. Public ActualSize As Long = -1
  1176. ''' <summary>
  1177. ''' 文件的最小大小。
  1178. ''' 不检查则为 -1。
  1179. ''' </summary>
  1180. Public MinSize As Long = -1
  1181. ''' <summary>
  1182. ''' 文件的 MD5、SHA1 或 SHA256。会根据输入字符串的长度自动判断种类。
  1183. ''' 不检查则为 Nothing。
  1184. ''' </summary>
  1185. Public Hash As String = Nothing
  1186. ''' <summary>
  1187. ''' 是否可以使用已经存在的文件。
  1188. ''' </summary>
  1189. Public CanUseExistsFile As Boolean = True
  1190. ''' <summary>
  1191. ''' 是否要求为 JSON 文件。
  1192. ''' 即,开头结尾必须为 {} 或 []。
  1193. ''' </summary>
  1194. Public IsJson As Boolean = False
  1195. Public Sub New(Optional MinSize As Long = -1, Optional ActualSize As Long = -1, Optional Hash As String = Nothing, Optional CanUseExistsFile As Boolean = True, Optional IsJson As Boolean = False)
  1196. Me.ActualSize = ActualSize
  1197. Me.MinSize = MinSize
  1198. Me.Hash = Hash
  1199. Me.CanUseExistsFile = CanUseExistsFile
  1200. Me.IsJson = IsJson
  1201. End Sub
  1202. ''' <summary>
  1203. ''' 检查文件。若成功则返回 Nothing,失败则返回错误的描述文本,描述文本不以句号结尾。不会抛出错误。
  1204. ''' </summary>
  1205. Public Function Check(LocalPath As String) As String
  1206. Try
  1207. Dim Info As New FileInfo(LocalPath)
  1208. If Not Info.Exists Then Return "文件不存在:" & LocalPath
  1209. Dim FileSize As Long = Info.Length
  1210. If ActualSize >= 0 AndAlso ActualSize <> FileSize Then
  1211. Return $"文件大小应为 {ActualSize} B,实际为 {FileSize} B" &
  1212. If(FileSize < 2000, ",内容为:" & ReadFile(LocalPath), "")
  1213. End If
  1214. If MinSize >= 0 AndAlso MinSize > FileSize Then
  1215. Return $"文件大小应大于 {MinSize} B,实际为 {FileSize} B" &
  1216. If(FileSize < 2000, ",内容为:" & ReadFile(LocalPath), "")
  1217. End If
  1218. If Not String.IsNullOrEmpty(Hash) Then
  1219. If Hash.Length < 35 Then 'MD5
  1220. If Hash.ToLowerInvariant <> GetFileMD5(LocalPath) Then Return "文件 MD5 应为 " & Hash & ",实际为 " & GetFileMD5(LocalPath)
  1221. ElseIf Hash.Length = 64 Then 'SHA256
  1222. If Hash.ToLowerInvariant <> GetFileSHA256(LocalPath) Then Return "文件 SHA256 应为 " & Hash & ",实际为 " & GetFileSHA256(LocalPath)
  1223. Else 'SHA1 (40)
  1224. If Hash.ToLowerInvariant <> GetFileSHA1(LocalPath) Then Return "文件 SHA1 应为 " & Hash & ",实际为 " & GetFileSHA1(LocalPath)
  1225. End If
  1226. End If
  1227. If IsJson Then
  1228. Dim Content As String = ReadFile(LocalPath)
  1229. If Content = "" Then Throw New Exception("读取到的文件为空")
  1230. Try
  1231. GetJson(Content)
  1232. Catch ex As Exception
  1233. Throw New Exception("不是有效的 json 文件", ex)
  1234. End Try
  1235. End If
  1236. Return Nothing
  1237. Catch ex As Exception
  1238. Log(ex, "检查文件出错")
  1239. Return ex.GetBrief()
  1240. End Try
  1241. End Function
  1242. End Class
  1243. ''' <summary>
  1244. ''' 尝试根据后缀名判断文件种类并解压文件,支持 gz 与 zip,会尝试将 jar 以 zip 方式解压。
  1245. ''' 会尝试创建,但不会清空目标文件夹。
  1246. ''' 会先使用 UTF-8 解压,失败后换用 GB18030 解压。
  1247. ''' </summary>
  1248. Public Sub ExtractCompressedFile(CompressFilePath As String, DestDirectory As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
  1249. Directory.CreateDirectory(DestDirectory)
  1250. '解压 gz(gz 不需要考虑编码)
  1251. If CompressFilePath.EndsWithF(".gz", True) Then
  1252. Using stream As New GZipStream(New FileStream(CompressFilePath, FileMode.Open, FileAccess.Read, FileShare.Read), CompressionMode.Decompress)
  1253. Using decompressedFile As New FileStream(DestDirectory & GetFileNameFromPath(CompressFilePath).ToLower.Replace(".tar", "").Replace(".gz", ""),
  1254. FileMode.OpenOrCreate, FileAccess.Write)
  1255. Dim data As Integer = stream.ReadByte()
  1256. While data <> -1
  1257. decompressedFile.WriteByte(data)
  1258. data = stream.ReadByte()
  1259. End While
  1260. End Using
  1261. End Using
  1262. Return
  1263. End If
  1264. '解压 zip
  1265. Dim TryExtractZip =
  1266. Sub(Encoding As Encoding)
  1267. Using Archive = ZipFile.Open(CompressFilePath, ZipArchiveMode.Read, Encoding)
  1268. Dim EntryCount = Archive.Entries.Count
  1269. For Each Entry In Archive.Entries
  1270. If ProgressIncrementHandler IsNot Nothing AndAlso EntryCount > 0 Then ProgressIncrementHandler(1 / EntryCount)
  1271. Dim DestinationFullPath As String = IO.Path.Combine(DestDirectory, Entry.FullName)
  1272. If Not IO.Path.GetFullPath(DestinationFullPath).StartsWithF(IO.Path.GetFullPath(DestDirectory), True) Then Continue For 'ZipSlip 漏洞修复
  1273. If DestinationFullPath.EndsWithF("\") OrElse DestinationFullPath.EndsWithF("/") Then Continue For '不创建空文件夹
  1274. Dim DestinationDirectory As String = GetPathFromFullPath(DestinationFullPath)
  1275. Directory.CreateDirectory(DestinationDirectory)
  1276. Entry.ExtractToFile(DestinationFullPath.Replace(DestinationDirectory, ShortenPath(DestinationDirectory)), True) '#7329
  1277. Next
  1278. End Using
  1279. End Sub
  1280. Try
  1281. TryExtractZip(Encoding.UTF8)
  1282. Catch ex As Exception
  1283. Log(ex, $"首次解压尝试失败,将更换编码并重试({CompressFilePath} → {DestDirectory})")
  1284. Try
  1285. TryExtractZip(Encoding.GetEncoding("GB18030"))
  1286. Catch
  1287. Throw
  1288. End Try
  1289. End Try
  1290. End Sub
  1291. ''' <summary>
  1292. ''' 删除文件夹,返回删除的文件个数。通过参数选择是否抛出异常。
  1293. ''' </summary>
  1294. Public Function DeleteDirectory(Path As String, Optional IgnoreIssue As Boolean = False) As Integer
  1295. If Not Directory.Exists(Path) Then Return 0
  1296. If Not Path.EndsWithF("\") Then Path &= "\"
  1297. If Path.EndsWith(":\") OrElse
  1298. Path = Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\" OrElse
  1299. Path = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" OrElse
  1300. Path = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\" Then '#7030
  1301. Throw New UnauthorizedAccessException("这是重要的系统文件夹,无法删除:" & Path)
  1302. End If
  1303. '实际删除
  1304. Dim DeletedCount As Integer = 0
  1305. Dim Files As String()
  1306. Try
  1307. Files = Directory.GetFiles(Path)
  1308. Catch ex As DirectoryNotFoundException '#4549
  1309. If Not Directory.Exists(Path) Then Return 0 '可能已被其他线程删除
  1310. Log(ex, $"疑似为孤立符号链接,尝试直接删除({Path})", LogLevel.Developer)
  1311. Directory.Delete(Path)
  1312. Return 0
  1313. End Try
  1314. For Each FilePath As String In Files
  1315. Dim RetriedFile As Boolean = False
  1316. RetryFile:
  1317. Try
  1318. File.Delete(FilePath)
  1319. DeletedCount += 1
  1320. Catch ex As Exception
  1321. If Not RetriedFile Then
  1322. RetriedFile = True
  1323. Log(ex, $"删除文件失败,将在 0.3s 后重试({FilePath})")
  1324. Thread.Sleep(300)
  1325. GoTo RetryFile
  1326. ElseIf IgnoreIssue Then
  1327. Log(ex, "删除单个文件可忽略地失败")
  1328. Else
  1329. Throw
  1330. End If
  1331. End Try
  1332. Next
  1333. For Each str As String In Directory.GetDirectories(Path)
  1334. DeleteDirectory(str, IgnoreIssue)
  1335. Next
  1336. Dim RetriedDir As Boolean = False
  1337. RetryDir:
  1338. Try
  1339. Directory.Delete(Path, True)
  1340. Catch ex As DirectoryNotFoundException
  1341. Catch ex As Exception
  1342. If Not RetriedDir AndAlso Not RunInUi() Then
  1343. RetriedDir = True
  1344. Log(ex, $"删除文件夹失败,将在 0.3s 后重试({Path})")
  1345. Thread.Sleep(300)
  1346. GoTo RetryDir
  1347. ElseIf IgnoreIssue Then
  1348. Log(ex, "删除单个文件夹可忽略地失败")
  1349. Else
  1350. Throw
  1351. End If
  1352. End Try
  1353. Return DeletedCount
  1354. End Function
  1355. ''' <summary>
  1356. ''' 复制文件夹,失败会抛出异常。
  1357. ''' </summary>
  1358. Public Sub CopyDirectory(FromPath As String, ToPath As String, Optional ProgressIncrementHandler As Action(Of Double) = Nothing)
  1359. FromPath = FromPath.Replace("/", "\")
  1360. If Not FromPath.EndsWithF("\") Then FromPath &= "\"
  1361. ToPath = ToPath.Replace("/", "\")
  1362. If Not ToPath.EndsWithF("\") Then ToPath &= "\"
  1363. Dim AllFiles = EnumerateFiles(FromPath).ToList
  1364. Dim FileCount As Long = AllFiles.Count
  1365. For Each File In AllFiles
  1366. CopyFile(File.FullName, File.FullName.Replace(FromPath, ToPath))
  1367. If ProgressIncrementHandler IsNot Nothing AndAlso FileCount > 0 Then ProgressIncrementHandler(1 / FileCount)
  1368. Next
  1369. End Sub
  1370. ''' <summary>
  1371. ''' 遍历文件夹中的所有文件。
  1372. ''' </summary>
  1373. Public Function EnumerateFiles(Directory As String) As IEnumerable(Of FileInfo)
  1374. Dim Info As New DirectoryInfo(Directory)
  1375. If Not Info.Exists Then Return New List(Of FileInfo)
  1376. Return Info.EnumerateFiles("*", SearchOption.AllDirectories)
  1377. End Function
  1378. ''' <summary>
  1379. ''' 若路径长度大于指定值,则将长路径转换为短路径。
  1380. ''' 如果路径不存在,则返回原始路径。
  1381. ''' </summary>
  1382. Public Function ShortenPath(LongPath As String) As String
  1383. If LongPath.Length <= 200 OrElse LongPath.StartsWithF("http", True) Then Return LongPath
  1384. If Not Directory.Exists(LongPath) AndAlso Not File.Exists(LongPath) Then Return LongPath
  1385. Dim ShortPath As New StringBuilder(260)
  1386. GetShortPathName(LongPath.Replace("/", "\"), ShortPath, 260) '第一个参数也会在调用后被修改,使用 Replace 后不会影响原始字符串
  1387. ShortenPath = ShortPath.ToString
  1388. If String.IsNullOrEmpty(ShortenPath) Then Return LongPath
  1389. End Function
  1390. Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (lpszLongPath As String, lpszShortPath As StringBuilder, cchBuffer As Integer) As Integer
  1391. #End Region
  1392. #Region "文本"
  1393. Public vbLQ As Char = Convert.ToChar(8220)
  1394. Public vbRQ As Char = Convert.ToChar(8221)
  1395. ''' <summary>
  1396. ''' 提取 Exception 与 Inner Exception 的详细描述与堆栈信息。返回内容总是多于一行。
  1397. ''' </summary>
  1398. ''' <param name="ShowAllStacks">是否必须显示所有堆栈。通常用于判定堆栈信息。</param>
  1399. <Extension> Public Function GetDetail(Ex As Exception, Optional ShowAllStacks As Boolean = False) As String
  1400. If Ex Is Nothing Then Return "无可用错误信息!"
  1401. '获取最底层的异常
  1402. Dim OuterEx As Exception = Ex
  1403. Dim InnerEx As Exception = Ex
  1404. Do Until InnerEx.InnerException Is Nothing
  1405. InnerEx = InnerEx.InnerException
  1406. Loop
  1407. '获取各级错误的描述与堆栈信息
  1408. Dim DescList As New List(Of String)
  1409. Dim IsInner As Boolean = False
  1410. Do Until Ex Is Nothing
  1411. DescList.Add(If(IsInner, "→ ", "") & Ex.Message.Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, vbCrLf))
  1412. If Ex.StackTrace IsNot Nothing Then
  1413. For Each Stack As String In Ex.StackTrace.Split(vbCrLf.ToCharArray, StringSplitOptions.RemoveEmptyEntries)
  1414. If ShowAllStacks OrElse Stack.ContainsF("pcl", True) Then
  1415. DescList.Add(Stack.Replace(vbCr, String.Empty).Replace(vbLf, String.Empty))
  1416. End If
  1417. Next
  1418. End If
  1419. If Ex.GetType.FullName <> "System.Exception" Then DescList.Add(" 错误类型:" & Ex.GetType.FullName)
  1420. Ex = Ex.InnerException
  1421. IsInner = True
  1422. Loop
  1423. '构造输出信息
  1424. Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
  1425. If UsualReason Is Nothing Then
  1426. Return DescList.Join(vbCrLf)
  1427. Else
  1428. Return UsualReason & vbCrLf & vbCrLf & "————————————" & vbCrLf & "详细错误信息:" & vbCrLf & DescList.Join(vbCrLf)
  1429. End If
  1430. End Function
  1431. ''' <summary>
  1432. ''' 提取 Exception 与 Inner Exception 的描述,汇总到一行。
  1433. ''' </summary>
  1434. <Extension> Public Function GetBrief(Ex As Exception) As String
  1435. If Ex Is Nothing Then Return "无可用错误信息!"
  1436. '获取最底层的异常
  1437. Dim OuterEx As Exception = Ex
  1438. Dim InnerEx As Exception = Ex
  1439. Do Until InnerEx.InnerException Is Nothing
  1440. InnerEx = InnerEx.InnerException
  1441. Loop
  1442. '获取各级错误的描述
  1443. Dim DescList As New List(Of String)
  1444. Do Until Ex Is Nothing
  1445. DescList.Add(Ex.Message.Replace(vbCrLf, vbCr).Replace(vbLf, vbCr).Replace(vbCr & vbCr, vbCr).Replace(vbCr, " "))
  1446. Ex = Ex.InnerException
  1447. Loop
  1448. DescList = DescList.Distinct.ToList
  1449. Dim Desc As String = Join(DescList, vbCrLf & "→ ")
  1450. '构造输出信息
  1451. Dim UsualReason As String = AnalyzeUsualReason(InnerEx, OuterEx, DescList)
  1452. If UsualReason IsNot Nothing Then
  1453. Return UsualReason & "详细错误:" & DescList.First
  1454. Else
  1455. DescList.Reverse() '让最深层错误在最左边
  1456. Return Join(DescList, " ← ")
  1457. End If
  1458. End Function
  1459. Private Function AnalyzeUsualReason(InnerEx As Exception, OuterEx As Exception, DescList As List(Of String)) As String
  1460. If TypeOf InnerEx Is TypeLoadException OrElse TypeOf InnerEx Is BadImageFormatException OrElse TypeOf InnerEx Is MissingMethodException OrElse TypeOf InnerEx Is NotImplementedException OrElse TypeOf InnerEx Is TypeInitializationException Then
  1461. Return "PCL 的运行环境存在问题。请尝试重新安装 .NET Framework 4.6.2 然后再试。若无法安装,请先卸载较新版本的 .NET Framework,然后再尝试安装。"
  1462. ElseIf TypeOf InnerEx Is UnauthorizedAccessException Then
  1463. Return "PCL 的权限不足。请尝试右键 PCL 选择以管理员身份运行。"
  1464. ElseIf TypeOf InnerEx Is OutOfMemoryException Then
  1465. Return "你的电脑运行内存不足,导致 PCL 无法继续运行。请在关闭一部分不需要的程序后再试。"
  1466. ElseIf TypeOf InnerEx Is Runtime.InteropServices.COMException Then
  1467. Return "由于操作系统或显卡存在问题,导致出现错误。请尝试重启 PCL。"
  1468. ElseIf TypeOf InnerEx Is SocketException AndAlso DescList.Any(Function(l) l.Contains("WSAStartup")) Then
  1469. Return "请尝试卸载中国移动云盘,然后再试。"
  1470. ElseIf OuterEx.IsNetworkRelated() Then
  1471. Return "你的网络环境不佳,请稍后再试,或使用 VPN 改善网络环境。"
  1472. Else
  1473. Return Nothing
  1474. End If
  1475. End Function
  1476. ''' <summary>
  1477. ''' 返回一个枚举对应的字符串。
  1478. ''' </summary>
  1479. ''' <param name="EnumData">一个已经实例化的枚举类型。</param>
  1480. Public Function GetStringFromEnum(EnumData As [Enum]) As String
  1481. Return [Enum].GetName(EnumData.GetType, EnumData)
  1482. End Function
  1483. ''' <summary>
  1484. ''' 将字符串转换为枚举类型,支持数字或原文两种格式,若为空字符串则返回 0。
  1485. ''' 若转换失败会抛出异常。
  1486. ''' </summary>
  1487. <Extension> Public Function ParseToEnum(Of T)(Str As String) As T
  1488. If String.IsNullOrEmpty(Str) Then
  1489. Return CType(0, Object)
  1490. ElseIf IsNumeric(Str) Then
  1491. Return CType(CInt(Str), Object)
  1492. Else
  1493. Return [Enum].Parse(GetType(T), Str, True)
  1494. End If
  1495. End Function
  1496. ''' <summary>
  1497. ''' 将文件大小转化为适合的文本形式,如“1.28 M”。
  1498. ''' </summary>
  1499. ''' <param name="FileSize">以字节为单位的大小表示。</param>
  1500. Public Function GetString(FileSize As Long) As String
  1501. Dim IsNegative = FileSize < 0
  1502. If IsNegative Then FileSize *= -1
  1503. If FileSize < 1000 Then
  1504. 'B 级
  1505. Return If(IsNegative, "-", "") & FileSize & " B"
  1506. ElseIf FileSize < 1024 * 1000 Then
  1507. 'K 级
  1508. Dim RoundResult As String = Math.Round(FileSize / 1024)
  1509. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " K"
  1510. ElseIf FileSize < 1024 * 1024 * 1000 Then
  1511. 'M 级
  1512. Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024)
  1513. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " M"
  1514. Else
  1515. 'G 级
  1516. Dim RoundResult As String = Math.Round(FileSize / 1024 / 1024 / 1024)
  1517. Return If(IsNegative, "-", "") & Math.Round(FileSize / 1024 / 1024 / 1024, CInt(MathClamp(3 - RoundResult.Length, 0, 2))) & " G"
  1518. End If
  1519. End Function
  1520. ''' <summary>
  1521. ''' 获取 JSON 对象。
  1522. ''' </summary>
  1523. Public Function GetJson(Data As String) As JToken
  1524. Try
  1525. Return JsonConvert.DeserializeObject(Data, New JsonSerializerSettings With {.DateTimeZoneHandling = DateTimeZoneHandling.Local})
  1526. Catch ex As Exception
  1527. Dim Length As Integer = If(Data, "").Length
  1528. Throw New Exception("格式化 JSON 失败:" & If(Length > 2000, Data.Substring(0, 500) & $"...(全长 {Length} 个字符)..." & Right(Data, 500), Data), ex)
  1529. End Try
  1530. End Function
  1531. ''' <summary>
  1532. ''' 将第一个字符转换为大写,其余字符转换为小写。
  1533. ''' </summary>
  1534. <Extension> Public Function Capitalize(word As String) As String
  1535. If String.IsNullOrEmpty(word) Then Return word
  1536. Return word.Substring(0, 1).ToUpperInvariant() & word.Substring(1).ToLowerInvariant()
  1537. End Function
  1538. ''' <summary>
  1539. ''' 将字符串统一至某个长度,过短则以 Code 将其右侧填充,过长则截取靠左的指定长度。
  1540. ''' </summary>
  1541. Public Function StrFill(Str As String, Code As String, Length As Byte) As String
  1542. If Str.Length > Length Then Return Mid(Str, 1, Length)
  1543. Return Mid(Str.PadRight(Length, Code), Str.Length + 1) & Str
  1544. End Function
  1545. ''' <summary>
  1546. ''' 移除字符串首尾的标点符号、回车,以及括号中、冒号后的补充说明内容。
  1547. ''' </summary>
  1548. Public Function StrTrim(Str As String, Optional RemoveQuote As Boolean = True)
  1549. If RemoveQuote Then Str = Str.Split("(")(0).Split(":")(0).Split("(")(0).Split(":")(0)
  1550. Return Str.Trim(".", "。", "!", " ", "!", "?", "?", vbCr, vbLf)
  1551. End Function
  1552. ''' <summary>
  1553. ''' 连接字符串。
  1554. ''' </summary>
  1555. <Extension> Public Function Join(List As IEnumerable, Split As String) As String
  1556. Dim Builder As New StringBuilder
  1557. Dim IsFirst As Boolean = True
  1558. For Each Element In List
  1559. If IsFirst Then
  1560. IsFirst = False
  1561. Else
  1562. Builder.Append(Split)
  1563. End If
  1564. If Element IsNot Nothing Then Builder.Append(Element)
  1565. Next
  1566. Return Builder.ToString
  1567. End Function
  1568. ''' <summary>
  1569. ''' 分割字符串。
  1570. ''' 若原始字符串为空,则返回 {""}。
  1571. ''' </summary>
  1572. <Extension> Public Function Split(FullStr As String, SplitStr As String) As String()
  1573. If SplitStr.Length = 1 Then
  1574. Return FullStr.Split(SplitStr(0))
  1575. Else
  1576. Return FullStr.Split({SplitStr}, StringSplitOptions.None)
  1577. End If
  1578. End Function
  1579. ''' <summary>
  1580. ''' 获取字符串哈希值。
  1581. ''' </summary>
  1582. Public Function GetHash(Str As String) As ULong
  1583. GetHash = 5381
  1584. For i = 0 To Str.Length - 1
  1585. GetHash = (GetHash << 5) Xor GetHash Xor CType(AscW(Str(i)), ULong)
  1586. Next
  1587. Return GetHash Xor &HA98F501BC684032FUL
  1588. End Function
  1589. ''' <summary>
  1590. ''' 获取字符串 MD5。
  1591. ''' </summary>
  1592. Public Function GetStringMD5(Str As String) As String
  1593. Using h = MD5Cng.Create()
  1594. Dim hashedDataBytes = h.ComputeHash(Encoding.GetEncoding("gb2312").GetBytes(Str))
  1595. Dim tmp As New StringBuilder(hashedDataBytes.Length * 2)
  1596. For Each i As Byte In hashedDataBytes
  1597. tmp.Append(i.ToString("x2"))
  1598. Next
  1599. Return tmp.ToString()
  1600. End Using
  1601. End Function
  1602. ''' <summary>
  1603. ''' 检查字符串中的字符是否均为 ASCII 字符。
  1604. ''' </summary>
  1605. <Extension> Public Function IsASCII(Input As String) As Boolean
  1606. Return Input.All(Function(c) AscW(c) < 128)
  1607. End Function
  1608. ''' <summary>
  1609. ''' 获取在子字符串第一次出现之前的部分,例如对 2024/11/08 拆切 / 会得到 2024。
  1610. ''' 如果未找到子字符串则不裁切。
  1611. ''' </summary>
  1612. <Extension> Public Function BeforeFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
  1613. Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
  1614. If Pos >= 0 Then
  1615. Return Str.Substring(0, Pos)
  1616. Else
  1617. Return Str
  1618. End If
  1619. End Function
  1620. ''' <summary>
  1621. ''' 获取在子字符串最后一次出现之前的部分,例如对 2024/11/08 拆切 / 会得到 2024/11。
  1622. ''' 如果未找到子字符串则不裁切。
  1623. ''' </summary>
  1624. <Extension> Public Function BeforeLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
  1625. Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
  1626. If Pos >= 0 Then
  1627. Return Str.Substring(0, Pos)
  1628. Else
  1629. Return Str
  1630. End If
  1631. End Function
  1632. ''' <summary>
  1633. ''' 获取在子字符串第一次出现之后的部分,例如对 2024/11/08 拆切 / 会得到 11/08。
  1634. ''' 如果未找到子字符串则不裁切。
  1635. ''' </summary>
  1636. <Extension> Public Function AfterFirst(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
  1637. Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.IndexOfF(Text, IgnoreCase))
  1638. If Pos >= 0 Then
  1639. Return Str.Substring(Pos + Text.Length)
  1640. Else
  1641. Return Str
  1642. End If
  1643. End Function
  1644. ''' <summary>
  1645. ''' 获取在子字符串最后一次出现之后的部分,例如对 2024/11/08 拆切 / 会得到 08。
  1646. ''' 如果未找到子字符串则不裁切。
  1647. ''' </summary>
  1648. <Extension> Public Function AfterLast(Str As String, Text As String, Optional IgnoreCase As Boolean = False) As String
  1649. Dim Pos As Integer = If(String.IsNullOrEmpty(Text), -1, Str.LastIndexOfF(Text, IgnoreCase))
  1650. If Pos >= 0 Then
  1651. Return Str.Substring(Pos + Text.Length)
  1652. Else
  1653. Return Str
  1654. End If
  1655. End Function
  1656. ''' <summary>
  1657. ''' 获取处于两个子字符串之间的部分,裁切尽可能多的内容。
  1658. ''' 等效于 AfterLast 后接 BeforeFirst。
  1659. ''' 如果未找到子字符串则不裁切。
  1660. ''' </summary>
  1661. <Extension> Public Function Between(Str As String, After As String, Before As String, Optional IgnoreCase As Boolean = False) As String
  1662. Dim StartPos As Integer = If(String.IsNullOrEmpty(After), -1, Str.LastIndexOfF(After, IgnoreCase))
  1663. If StartPos >= 0 Then
  1664. StartPos += After.Length
  1665. Else
  1666. StartPos = 0
  1667. End If
  1668. Dim EndPos As Integer = If(String.IsNullOrEmpty(Before), -1, Str.IndexOfF(Before, StartPos, IgnoreCase))
  1669. If EndPos >= 0 Then
  1670. Return Str.Substring(StartPos, EndPos - StartPos)
  1671. ElseIf StartPos > 0 Then
  1672. Return Str.Substring(StartPos)
  1673. Else
  1674. Return Str
  1675. End If
  1676. End Function
  1677. ''' <summary>
  1678. ''' 高速的 StartsWith。
  1679. ''' </summary>
  1680. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1681. Public Function StartsWithF(Str As String, Prefix As String, Optional IgnoreCase As Boolean = False) As Boolean
  1682. If Str Is Nothing Then Return False
  1683. Return Str.StartsWith(Prefix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1684. End Function
  1685. ''' <summary>
  1686. ''' 高速的 EndsWith。
  1687. ''' </summary>
  1688. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1689. Public Function EndsWithF(Str As String, Suffix As String, Optional IgnoreCase As Boolean = False) As Boolean
  1690. If Str Is Nothing Then Return False
  1691. Return Str.EndsWith(Suffix, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1692. End Function
  1693. ''' <summary>
  1694. ''' 支持可变大小写判断的 Contains。
  1695. ''' </summary>
  1696. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1697. Public Function ContainsF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Boolean
  1698. If Str Is Nothing Then Return False
  1699. Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal)) >= 0
  1700. End Function
  1701. ''' <summary>
  1702. ''' 高速的 IndexOf。
  1703. ''' </summary>
  1704. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1705. Public Function IndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
  1706. Return Str.IndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1707. End Function
  1708. ''' <summary>
  1709. ''' 高速的 IndexOf。
  1710. ''' </summary>
  1711. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1712. Public Function IndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
  1713. Return Str.IndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1714. End Function
  1715. ''' <summary>
  1716. ''' 高速的 LastIndexOf。
  1717. ''' </summary>
  1718. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1719. Public Function LastIndexOfF(Str As String, SubStr As String, Optional IgnoreCase As Boolean = False) As Integer
  1720. Return Str.LastIndexOf(SubStr, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1721. End Function
  1722. ''' <summary>
  1723. ''' 高速的 LastIndexOf。
  1724. ''' </summary>
  1725. <Extension> <MethodImpl(MethodImplOptions.AggressiveInlining)>
  1726. Public Function LastIndexOfF(Str As String, SubStr As String, StartIndex As Integer, Optional IgnoreCase As Boolean = False) As Integer
  1727. Return Str.LastIndexOf(SubStr, StartIndex, If(IgnoreCase, StringComparison.OrdinalIgnoreCase, StringComparison.Ordinal))
  1728. End Function
  1729. ''' <summary>
  1730. ''' 不会报错的 Val。
  1731. ''' 如果输入有误,返回 0。
  1732. ''' </summary>
  1733. Public Function Val(Str As Object) As Double
  1734. If Str Is Nothing Then Return 0
  1735. Try
  1736. Return If(TypeOf Str Is String AndAlso Str = "&", 0, Conversion.Val(Str))
  1737. Catch
  1738. Return 0
  1739. End Try
  1740. End Function
  1741. '转义
  1742. ''' <summary>
  1743. ''' 为字符串进行 XML 转义。
  1744. ''' </summary>
  1745. Public Function EscapeXML(Str As String) As String
  1746. If Str.StartsWithF("{") Then Str = "{}" & Str '#4187
  1747. Return Str.
  1748. Replace("&", "&amp;").Replace("<", "&lt;").Replace(">", "&gt;").Replace("'", "&apos;").
  1749. Replace("""", "&quot;").Replace(vbCrLf, "&#xa;")
  1750. End Function
  1751. ''' <summary>
  1752. ''' 为字符串进行 Like 关键字转义。
  1753. ''' </summary>
  1754. Public Function EscapeLikePattern(input As String) As String
  1755. Dim sb As New StringBuilder()
  1756. For Each c As Char In input
  1757. Select Case c
  1758. Case "["c, "]"c, "*"c, "?"c, "#"c
  1759. sb.Append("["c).Append(c).Append("]"c)
  1760. Case Else
  1761. sb.Append(c)
  1762. End Select
  1763. Next
  1764. Return sb.ToString()
  1765. End Function
  1766. '正则
  1767. ''' <summary>
  1768. ''' 搜索字符串中的所有正则匹配项。
  1769. ''' </summary>
  1770. <Extension> Public Function RegexSearch(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As List(Of String)
  1771. Try
  1772. RegexSearch = New List(Of String)
  1773. Dim RegexSearchRes = New Regex(regex, options).Matches(str)
  1774. If RegexSearchRes Is Nothing Then Return RegexSearch
  1775. For Each item As Match In RegexSearchRes
  1776. RegexSearch.Add(item.Value)
  1777. Next
  1778. Catch ex As Exception
  1779. Log(ex, "正则匹配全部项出错")
  1780. Return New List(Of String)
  1781. End Try
  1782. End Function
  1783. ''' <summary>
  1784. ''' 获取字符串中的第一个正则匹配项,若无匹配则返回 Nothing。
  1785. ''' </summary>
  1786. <Extension> Public Function RegexSeek(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As String
  1787. Try
  1788. Dim Result = RegularExpressions.Regex.Match(str, regex, options).Value
  1789. Return If(Result = "", Nothing, Result)
  1790. Catch ex As Exception
  1791. Log(ex, "正则匹配第一项出错")
  1792. Return Nothing
  1793. End Try
  1794. End Function
  1795. ''' <summary>
  1796. ''' 检查字符串是否匹配某正则模式。
  1797. ''' </summary>
  1798. <Extension> Public Function RegexCheck(str As String, regex As String, Optional options As RegexOptions = RegexOptions.None) As Boolean
  1799. Try
  1800. Return RegularExpressions.Regex.IsMatch(str, regex, options)
  1801. Catch ex As Exception
  1802. Log(ex, "正则检查出错")
  1803. Return False
  1804. End Try
  1805. End Function
  1806. ''' <summary>
  1807. ''' 进行正则替换,会抛出错误。
  1808. ''' </summary>
  1809. <Extension> Public Function RegexReplace(AllContents As String, SearchRegex As String, ReplaceTo As String, Optional options As RegexOptions = RegexOptions.None) As String
  1810. Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
  1811. End Function
  1812. ''' <summary>
  1813. ''' 对每个正则匹配分别进行替换,会抛出错误。
  1814. ''' </summary>
  1815. <Extension> Public Function RegexReplaceEach(AllContents As String, SearchRegex As String, ReplaceTo As MatchEvaluator, Optional options As RegexOptions = RegexOptions.None) As String
  1816. Return Regex.Replace(AllContents, SearchRegex, ReplaceTo, options)
  1817. End Function
  1818. #End Region
  1819. #Region "搜索"
  1820. ''' <summary>
  1821. ''' 获取搜索文本的相似度。
  1822. ''' </summary>
  1823. ''' <param name="Source">被搜索的长内容。</param>
  1824. ''' <param name="Query">用户输入的搜索文本。</param>
  1825. Private Function SearchSimilarity(Source As String, Query As String) As Double
  1826. Dim qp As Integer = 0, lenSum As Double = 0
  1827. Source = Source.ToLower.Replace(" ", "")
  1828. Query = Query.ToLower.Replace(" ", "")
  1829. Dim sourceLength As Integer = Source.Length, queryLength As Integer = Query.Length '用于计算最后因数的长度缓存
  1830. Do While qp < queryLength
  1831. '对 qp 作为开始位置计算
  1832. Dim sp As Integer = 0, lenMax As Integer = 0, spMax As Integer = 0
  1833. '查找以 qp 为头的最大子串
  1834. Do While sp < Source.Length
  1835. '对每个 sp 作为开始位置计算最大子串
  1836. Dim len As Integer = 0
  1837. Do While (qp + len) < queryLength AndAlso (sp + len) < Source.Length AndAlso Source(sp + len) = Query(qp + len)
  1838. len += 1
  1839. Loop
  1840. '存储 len
  1841. If len > lenMax Then
  1842. lenMax = len
  1843. spMax = sp
  1844. End If
  1845. '根据结果增加 sp
  1846. sp += Math.Max(1, len)
  1847. Loop
  1848. If lenMax > 0 Then
  1849. Source = Source.Substring(0, spMax) & If(Source.Count > spMax + lenMax, Source.Substring(spMax + lenMax), String.Empty) '将源中的对应字段替换空
  1850. '存储 lenSum
  1851. Dim IncWeight = (Math.Pow(1.4, 3 + lenMax) - 3.6) '根据长度加成
  1852. IncWeight *= 1 + 0.3 * Math.Max(0, 3 - Math.Abs(qp - spMax)) '根据位置加成
  1853. lenSum += IncWeight
  1854. End If
  1855. '根据结果增加 qp
  1856. qp += Math.Max(1, lenMax)
  1857. Loop
  1858. '计算结果:重复字段量 × 源长度影响比例
  1859. Return (lenSum / queryLength) * (3 / Math.Pow(sourceLength + 15, 0.5)) * If(queryLength <= 2, 3 - queryLength, 1)
  1860. End Function
  1861. ''' <summary>
  1862. ''' 获取多段文本加权后的相似度。
  1863. ''' </summary>
  1864. Private Function SearchSimilarityWeighted(Source As List(Of KeyValuePair(Of String, Double)), Query As String) As Double
  1865. Dim TotalWeight As Double = 0
  1866. Dim Sum As Double = 0
  1867. For Each Pair In Source
  1868. Sum += SearchSimilarity(Pair.Key, Query) * Pair.Value
  1869. TotalWeight += Pair.Value
  1870. Next
  1871. Return Sum / TotalWeight
  1872. End Function
  1873. ''' <summary>
  1874. ''' 用于搜索的项目。
  1875. ''' </summary>
  1876. Public Class SearchEntry(Of T)
  1877. ''' <summary>
  1878. ''' 该项目对应的源数据。
  1879. ''' </summary>
  1880. Public Item As T
  1881. ''' <summary>
  1882. ''' 该项目用于搜索的源。
  1883. ''' </summary>
  1884. Public SearchSource As List(Of KeyValuePair(Of String, Double))
  1885. ''' <summary>
  1886. ''' 相似度。
  1887. ''' </summary>
  1888. Public Similarity As Double
  1889. ''' <summary>
  1890. ''' 是否完全匹配。
  1891. ''' </summary>
  1892. Public AbsoluteRight As Boolean
  1893. End Class
  1894. ''' <summary>
  1895. ''' 进行多段文本加权搜索,获取相似度较高的数项结果。
  1896. ''' </summary>
  1897. ''' <param name="MaxBlurCount">返回的最大模糊结果数。</param>
  1898. ''' <param name="MinBlurSimilarity">返回结果要求的最低相似度。</param>
  1899. Public Function Search(Of T)(Entries As List(Of SearchEntry(Of T)), Query As String, Optional MaxBlurCount As Integer = 5, Optional MinBlurSimilarity As Double = 0.1) As List(Of SearchEntry(Of T))
  1900. '初始化
  1901. Dim ResultList As New List(Of SearchEntry(Of T))
  1902. If Not Entries.Any() Then Return ResultList
  1903. '进行搜索,获取相似信息
  1904. For Each Entry In Entries
  1905. Entry.Similarity = SearchSimilarityWeighted(Entry.SearchSource, Query)
  1906. Entry.AbsoluteRight =
  1907. Query.Split(" ").All( '对于按空格分割的每一段
  1908. Function(QueryPart) Entry.SearchSource.Any( '若与任意一个搜索源完全匹配,则标记为完全匹配项
  1909. Function(Source) Source.Key.Replace(" ", "").ContainsF(QueryPart, True)))
  1910. Next
  1911. '按照相似度进行排序
  1912. Entries = Entries.SortByComparison(
  1913. Function(Left, Right) As Boolean
  1914. If Left.AbsoluteRight Xor Right.AbsoluteRight Then
  1915. Return Left.AbsoluteRight
  1916. Else
  1917. Return Left.Similarity > Right.Similarity
  1918. End If
  1919. End Function)
  1920. '返回结果
  1921. Dim BlurCount As Integer = 0
  1922. For Each Entry In Entries
  1923. If Entry.AbsoluteRight Then
  1924. ResultList.Add(Entry) '完全匹配,直接加入
  1925. Else
  1926. If Entry.Similarity < MinBlurSimilarity OrElse BlurCount = MaxBlurCount Then Exit For '模糊结果边界条件
  1927. ResultList.Add(Entry)
  1928. BlurCount += 1 '模糊结果计数
  1929. End If
  1930. Next
  1931. Return ResultList
  1932. End Function
  1933. #End Region
  1934. #Region "系统"
  1935. ''' <summary>
  1936. ''' 线程安全的 List。
  1937. ''' 通过在 For Each 循环中使用一个浅表副本规避多线程操作或移除自身导致的异常。
  1938. ''' </summary>
  1939. Public Class SafeList(Of T)
  1940. Inherits SynchronizedCollection(Of T)
  1941. Implements IEnumerable, IEnumerable(Of T)
  1942. '构造函数
  1943. Public Sub New()
  1944. MyBase.New()
  1945. End Sub
  1946. Public Sub New(Data As IEnumerable(Of T))
  1947. MyBase.New(New Object, Data)
  1948. End Sub
  1949. Public Shared Widening Operator CType(Data As List(Of T)) As SafeList(Of T)
  1950. Return New SafeList(Of T)(Data)
  1951. End Operator
  1952. Public Shared Widening Operator CType(Data As SafeList(Of T)) As List(Of T)
  1953. Return New List(Of T)(Data)
  1954. End Operator
  1955. '基于 SyncLock 覆写
  1956. Public Overloads Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator
  1957. SyncLock SyncRoot
  1958. Return Items.ToList.GetEnumerator()
  1959. End SyncLock
  1960. End Function
  1961. Private Overloads Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator
  1962. SyncLock SyncRoot
  1963. Return Items.ToList.GetEnumerator()
  1964. End SyncLock
  1965. End Function
  1966. End Class
  1967. ''' <summary>
  1968. ''' 线程安全的字典。
  1969. ''' 通过在 For Each 循环中使用一个浅表副本规避多线程操作或移除自身导致的异常。
  1970. ''' </summary>
  1971. Public Class SafeDictionary(Of TKey, TValue)
  1972. Implements IDictionary(Of TKey, TValue)
  1973. Implements IEnumerable(Of KeyValuePair(Of TKey, TValue))
  1974. Public ReadOnly SyncRoot As New Object
  1975. Private ReadOnly _Dictionary As New Dictionary(Of TKey, TValue)
  1976. '构造函数
  1977. Public Sub New()
  1978. End Sub
  1979. Public Sub New(Data As IEnumerable(Of KeyValuePair(Of TKey, TValue)))
  1980. For Each DataItem In Data
  1981. _Dictionary.Add(DataItem.Key, DataItem.Value)
  1982. Next
  1983. End Sub
  1984. '线程安全的方法实现
  1985. Public Sub Add(key As TKey, value As TValue) Implements IDictionary(Of TKey, TValue).Add
  1986. SyncLock SyncRoot
  1987. _Dictionary.Add(key, value)
  1988. End SyncLock
  1989. End Sub
  1990. Public Function ContainsKey(key As TKey) As Boolean Implements IDictionary(Of TKey, TValue).ContainsKey
  1991. SyncLock SyncRoot
  1992. Return _Dictionary.ContainsKey(key)
  1993. End SyncLock
  1994. End Function
  1995. Public ReadOnly Property Keys As ICollection(Of TKey) Implements IDictionary(Of TKey, TValue).Keys
  1996. Get
  1997. SyncLock SyncRoot
  1998. Return New List(Of TKey)(_Dictionary.Keys)
  1999. End SyncLock
  2000. End Get
  2001. End Property
  2002. Public Function Remove(key As TKey) As Boolean Implements IDictionary(Of TKey, TValue).Remove
  2003. SyncLock SyncRoot
  2004. Return _Dictionary.Remove(key)
  2005. End SyncLock
  2006. End Function
  2007. Public Function TryGetValue(key As TKey, ByRef value As TValue) As Boolean Implements IDictionary(Of TKey, TValue).TryGetValue
  2008. SyncLock SyncRoot
  2009. Return _Dictionary.TryGetValue(key, value)
  2010. End SyncLock
  2011. End Function
  2012. Public ReadOnly Property Values As ICollection(Of TValue) Implements IDictionary(Of TKey, TValue).Values
  2013. Get
  2014. SyncLock SyncRoot
  2015. Return New List(Of TValue)(_Dictionary.Values)
  2016. End SyncLock
  2017. End Get
  2018. End Property
  2019. Default Public Property Item(key As TKey) As TValue Implements IDictionary(Of TKey, TValue).Item
  2020. Get
  2021. SyncLock SyncRoot
  2022. Return _Dictionary(key)
  2023. End SyncLock
  2024. End Get
  2025. Set(value As TValue)
  2026. SyncLock SyncRoot
  2027. _Dictionary(key) = value
  2028. End SyncLock
  2029. End Set
  2030. End Property
  2031. Public Sub Add(item As KeyValuePair(Of TKey, TValue)) Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Add
  2032. SyncLock SyncRoot
  2033. _Dictionary.Add(item.Key, item.Value)
  2034. End SyncLock
  2035. End Sub
  2036. Public Sub Clear() Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Clear
  2037. SyncLock SyncRoot
  2038. _Dictionary.Clear()
  2039. End SyncLock
  2040. End Sub
  2041. Public Function Contains(item As KeyValuePair(Of TKey, TValue)) As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Contains
  2042. SyncLock SyncRoot
  2043. Return DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).Contains(item)
  2044. End SyncLock
  2045. End Function
  2046. Public Sub CopyTo(array() As KeyValuePair(Of TKey, TValue), arrayIndex As Integer) Implements ICollection(Of KeyValuePair(Of TKey, TValue)).CopyTo
  2047. SyncLock SyncRoot
  2048. DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).CopyTo(array, arrayIndex)
  2049. End SyncLock
  2050. End Sub
  2051. Public ReadOnly Property Count As Integer Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Count
  2052. Get
  2053. SyncLock SyncRoot
  2054. Return _Dictionary.Count
  2055. End SyncLock
  2056. End Get
  2057. End Property
  2058. Public ReadOnly Property IsReadOnly As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).IsReadOnly
  2059. Get
  2060. Return False
  2061. End Get
  2062. End Property
  2063. Public Function Remove(item As KeyValuePair(Of TKey, TValue)) As Boolean Implements ICollection(Of KeyValuePair(Of TKey, TValue)).Remove
  2064. SyncLock SyncRoot
  2065. Return DirectCast(_Dictionary, IDictionary(Of TKey, TValue)).Remove(item)
  2066. End SyncLock
  2067. End Function
  2068. '枚举器
  2069. Public Function GetEnumerator() As IEnumerator(Of KeyValuePair(Of TKey, TValue)) Implements IEnumerable(Of KeyValuePair(Of TKey, TValue)).GetEnumerator
  2070. SyncLock SyncRoot
  2071. Return New List(Of KeyValuePair(Of TKey, TValue))(_Dictionary).GetEnumerator()
  2072. End SyncLock
  2073. End Function
  2074. Private Function GetEnumeratorGeneral() As IEnumerator Implements IEnumerable.GetEnumerator
  2075. Return GetEnumerator()
  2076. End Function
  2077. End Class
  2078. ''' <summary>
  2079. ''' 将二维数组转换为字典。
  2080. ''' </summary>
  2081. <Extension> Public Function ToDictionary(Of T)(arr As T(,)) As Dictionary(Of T, T)
  2082. Dim result As New Dictionary(Of T, T)
  2083. If arr.Length = 0 Then Return result
  2084. If arr.GetLength(1) <> 2 Then Throw New ArgumentException("数组必须为两列,第一列为 Key,第二列为 Value。")
  2085. For i As Integer = 0 To arr.GetLength(0) - 1
  2086. result(arr(i, 0)) = arr(i, 1)
  2087. Next
  2088. Return result
  2089. End Function
  2090. ''' <summary>
  2091. ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
  2092. ''' </summary>
  2093. <Extension> Public Function GetResultWithTimeout(Of T)(TargetTask As Task(Of T), TokenSource As CancellationTokenSource, TimeoutMs As Integer) As T
  2094. Dim DelayTask = Task.Delay(TimeoutMs)
  2095. If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
  2096. TokenSource.Cancel()
  2097. Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
  2098. End If
  2099. Return TargetTask.GetAwaiter().GetResult()
  2100. End Function
  2101. ''' <summary>
  2102. ''' 为 Task 设置超时,在超时时抛出 TimeoutException。
  2103. ''' </summary>
  2104. <Extension> Public Sub GetResultWithTimeout(TargetTask As Task, TokenSource As CancellationTokenSource, TimeoutMs As Integer)
  2105. Dim DelayTask = Task.Delay(TimeoutMs)
  2106. If Task.WhenAny(TargetTask, DelayTask).GetAwaiter().GetResult() Is DelayTask Then
  2107. TokenSource.Cancel()
  2108. Throw New TimeoutException($"任务超时({TimeoutMs} ms)")
  2109. End If
  2110. TargetTask.GetAwaiter().GetResult()
  2111. End Sub
  2112. ''' <summary>
  2113. ''' 可用于临时存放文件的,不含任何特殊字符的文件夹路径,以“\”结尾。
  2114. ''' </summary>
  2115. Public PathPure As String = GetPureASCIIDir()
  2116. Private Function GetPureASCIIDir() As String
  2117. If (Path & "PCL").IsASCII() Then
  2118. Return Path & "PCL\"
  2119. ElseIf PathAppdata.IsASCII() Then
  2120. Return PathAppdata
  2121. ElseIf PathTemp.IsASCII() Then
  2122. Return PathTemp
  2123. Else
  2124. Return OsDrive & "ProgramData\PCL\"
  2125. End If
  2126. End Function
  2127. ''' <summary>
  2128. ''' 指示接取到这个异常的函数进行重试。
  2129. ''' </summary>
  2130. Public Class RestartException
  2131. Inherits Exception
  2132. End Class
  2133. ''' <summary>
  2134. ''' 指示用户手动取消了操作,或用户已知晓操作被取消的原因。
  2135. ''' </summary>
  2136. Public Class CancelledException
  2137. Inherits Exception
  2138. End Class
  2139. ''' <summary>
  2140. ''' 当前程序是否拥有管理员权限。
  2141. ''' </summary>
  2142. Public Function IsAdmin() As Boolean
  2143. Dim id As WindowsIdentity = WindowsIdentity.GetCurrent()
  2144. Dim principal As New WindowsPrincipal(id)
  2145. Return principal.IsInRole(WindowsBuiltInRole.Administrator)
  2146. End Function
  2147. ''' <summary>
  2148. ''' 以管理员权限运行当前程序,并等待程序运行结束。
  2149. ''' 返回程序的返回代码,如果运行失败将抛出异常。
  2150. ''' </summary>
  2151. Public Function RunAsAdmin(Argument As String) As Integer
  2152. Dim NewProcess = StartProcess(New ProcessStartInfo(PathWithName) With {.Verb = "runas", .Arguments = Argument})
  2153. NewProcess.WaitForExit()
  2154. Return NewProcess.ExitCode
  2155. End Function
  2156. ''' <summary>
  2157. ''' 判断当前系统语言是否为中文。
  2158. ''' </summary>
  2159. Public Function IsSystemLanguageChinese() As Boolean
  2160. Return CultureInfo.CurrentCulture.Name.StartsWithF("zh-") OrElse CultureInfo.CurrentUICulture.Name.StartsWithF("zh-")
  2161. End Function
  2162. ''' <summary>
  2163. ''' 判断对象是否为某个泛型类型的实例。
  2164. ''' </summary>
  2165. <Extension> Public Function IsInstanceOfGenericType(genericType As Type, obj As Object) As Boolean
  2166. If obj Is Nothing Then Return False
  2167. Dim t = obj.GetType()
  2168. While t IsNot Nothing
  2169. If t.IsGenericType AndAlso t.GetGenericTypeDefinition() Is genericType Then Return True
  2170. t = t.BaseType
  2171. End While
  2172. Return False
  2173. End Function
  2174. Private Uuid As Integer = 1
  2175. Private UuidLock As Object
  2176. ''' <summary>
  2177. ''' 获取一个全程序内不会重复的数字(伪 Uuid)。
  2178. ''' </summary>
  2179. Public Function GetUuid() As Integer
  2180. If UuidLock Is Nothing Then UuidLock = New Object
  2181. SyncLock UuidLock
  2182. Uuid += 1
  2183. Return Uuid
  2184. End SyncLock
  2185. End Function
  2186. ''' <summary>
  2187. ''' 将元素与 List 的混合体拆分为元素组。
  2188. ''' </summary>
  2189. Public Function GetFullList(Of T)(data As IList) As List(Of T)
  2190. GetFullList = New List(Of T)
  2191. For i = 0 To data.Count - 1
  2192. If TypeOf data(i) Is ICollection Then
  2193. GetFullList.AddRange(data(i))
  2194. Else
  2195. GetFullList.Add(data(i))
  2196. End If
  2197. Next i
  2198. End Function
  2199. ''' <summary>
  2200. ''' 去重。
  2201. ''' </summary>
  2202. <Extension> Public Function Distinct(Of T)(Arr As ICollection(Of T), IsEqual As ComparisonBoolean(Of T)) As List(Of T)
  2203. Dim ResultArray As New List(Of T)
  2204. For i = 0 To Arr.Count - 1
  2205. For ii = i + 1 To Arr.Count - 1
  2206. If IsEqual(Arr(i), Arr(ii)) Then GoTo NextElement
  2207. Next
  2208. ResultArray.Add(Arr(i))
  2209. NextElement:
  2210. Next i
  2211. Return ResultArray
  2212. End Function
  2213. <Extension> Public Function Any(Arr As UIElementCollection) As Boolean
  2214. Return Arr?.Count > 0
  2215. End Function
  2216. ''' <summary>
  2217. ''' 对集合的每个元素执行指定操作。
  2218. ''' </summary>
  2219. <Extension> Public Function ForEach(Of T)(Collection As IEnumerable(Of T), Action As Action(Of T)) As IEnumerable(Of T)
  2220. For Each Item As T In Collection
  2221. Action(Item)
  2222. Next
  2223. Return Collection
  2224. End Function
  2225. ''' <summary>
  2226. ''' 获取格式类似于“11:08:52.037”的当前时间的字符串。
  2227. ''' </summary>
  2228. Public Function GetTimeNow() As String
  2229. Return Date.Now.ToString("HH':'mm':'ss'.'fff")
  2230. End Function
  2231. ''' <summary>
  2232. ''' 获取一个单调递增时间值(毫秒)。
  2233. ''' </summary>
  2234. Public Function GetTimeMs() As Long
  2235. Return Stopwatch.GetTimestamp() \ (Stopwatch.Frequency \ 1000L)
  2236. End Function
  2237. ''' <summary>
  2238. ''' 将时间间隔转换为类似“5 分 10 秒前”的易于阅读的形式。
  2239. ''' </summary>
  2240. Public Function GetTimeSpanString(Span As TimeSpan, IsShortForm As Boolean) As String
  2241. Dim EndFix = If(Span.TotalMilliseconds > 0, "后", "前")
  2242. If Span.TotalMilliseconds < 0 Then Span = -Span
  2243. Dim TotalMonthes = Math.Floor(Span.Days / 30)
  2244. If IsShortForm Then
  2245. If TotalMonthes >= 12 Then
  2246. '1+ 年,“3 年”
  2247. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
  2248. ElseIf TotalMonthes >= 2 Then
  2249. '2~11 月,“5 个月”
  2250. GetTimeSpanString = TotalMonthes & " 个月"
  2251. ElseIf Span.TotalDays >= 2 Then
  2252. '2 天 ~ 2 月,“23 天”
  2253. GetTimeSpanString = Span.Days & " 天"
  2254. ElseIf Span.TotalHours >= 1 Then
  2255. '1 小时 ~ 2 天,“15 小时”
  2256. GetTimeSpanString = Span.Hours & " 小时"
  2257. ElseIf Span.TotalMinutes >= 1 Then
  2258. '1 分钟 ~ 1 小时,“49 分钟”
  2259. GetTimeSpanString = Span.Minutes & " 分钟"
  2260. ElseIf Span.TotalSeconds >= 1 Then
  2261. '1 秒 ~ 1 分钟,“23 秒”
  2262. GetTimeSpanString = Span.Seconds & " 秒"
  2263. Else
  2264. '不到 1 秒
  2265. GetTimeSpanString = "1 秒"
  2266. End If
  2267. Else
  2268. If TotalMonthes >= 61 Then
  2269. '5+ 年,“5 年”
  2270. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年"
  2271. ElseIf TotalMonthes >= 12 Then
  2272. '12~60 月,“1 年 2 个月”
  2273. GetTimeSpanString = Math.Floor(TotalMonthes / 12) & " 年" & If((TotalMonthes Mod 12) > 0, " " & (TotalMonthes Mod 12) & " 个月", "")
  2274. ElseIf TotalMonthes >= 4 Then
  2275. '4~11 月,“5 个月”
  2276. GetTimeSpanString = TotalMonthes & " 个月"
  2277. ElseIf TotalMonthes >= 1 Then
  2278. '1~4 月,“2 个月 13 天”
  2279. GetTimeSpanString = TotalMonthes & " 月" & If((Span.Days Mod 30) > 0, " " & (Span.Days Mod 30) & " 天", "")
  2280. ElseIf Span.TotalDays >= 4 Then
  2281. '4~30 天,“23 天”
  2282. GetTimeSpanString = Span.Days & " 天"
  2283. ElseIf Span.TotalDays >= 1 Then
  2284. '1~3 天,“2 天 20 小时”
  2285. GetTimeSpanString = Span.Days & " 天" & If(Span.Hours > 0, " " & Span.Hours & " 小时", "")
  2286. ElseIf Span.TotalHours >= 10 Then
  2287. '10 小时 ~ 1 天,“15 小时”
  2288. GetTimeSpanString = Span.Hours & " 小时"
  2289. ElseIf Span.TotalHours >= 1 Then
  2290. '1~10 小时,“1 小时 20 分钟”
  2291. GetTimeSpanString = Span.Hours & " 小时" & If(Span.Minutes > 0, " " & Span.Minutes & " 分钟", "")
  2292. ElseIf Span.TotalMinutes >= 10 Then
  2293. '10 分钟 ~ 1 小时,“49 分钟”
  2294. GetTimeSpanString = Span.Minutes & " 分钟"
  2295. ElseIf Span.TotalMinutes >= 1 Then
  2296. '1~10 分钟,“9 分 23 秒”
  2297. GetTimeSpanString = Span.Minutes & " 分" & If(Span.Seconds > 0, " " & Span.Seconds & " 秒", "")
  2298. ElseIf Span.TotalSeconds >= 1 Then
  2299. '1 秒 ~ 1 分钟,“23 秒”
  2300. GetTimeSpanString = Span.Seconds & " 秒"
  2301. Else
  2302. '不到 1 秒
  2303. GetTimeSpanString = "1 秒"
  2304. End If
  2305. End If
  2306. GetTimeSpanString += EndFix
  2307. End Function
  2308. ''' <summary>
  2309. ''' 获取十进制 Unix 时间戳。
  2310. ''' </summary>
  2311. Public Function GetUnixTimestamp() As Long
  2312. Return (Now.ToUniversalTime().Ticks - 621355968000000000) / 10000000
  2313. End Function
  2314. ''' <summary>
  2315. ''' 用于储存 RaiseByMouse 的 EventArgs。
  2316. ''' </summary>
  2317. Public NotInheritable Class RouteEventArgs
  2318. Inherits EventArgs
  2319. Public RaiseByMouse As Boolean
  2320. Public Handled As Boolean = False
  2321. Public Sub New(Optional RaiseByMouse As Boolean = False)
  2322. Me.RaiseByMouse = RaiseByMouse
  2323. End Sub
  2324. End Class
  2325. ''' <summary>
  2326. ''' 启动进程并返回进程实例,若失败则抛出异常。
  2327. ''' 会自动进行长路径处理。
  2328. ''' </summary>
  2329. Public Function StartProcess(FileName As String, Optional Arguments As String = "") As Process
  2330. Return StartProcess(New ProcessStartInfo With {.FileName = FileName, .Arguments = Arguments})
  2331. End Function
  2332. ''' <summary>
  2333. ''' 启动进程并返回进程实例,若失败则抛出异常。
  2334. ''' 会自动进行长路径处理。
  2335. ''' </summary>
  2336. Public Function StartProcess(StartInfo As ProcessStartInfo) As Process
  2337. StartInfo.FileName = ShortenPath(StartInfo.FileName)
  2338. If Not String.IsNullOrEmpty(StartInfo.WorkingDirectory) Then StartInfo.WorkingDirectory = ShortenPath(StartInfo.WorkingDirectory)
  2339. Log("[System] 启动进程:" & StartInfo.FileName & " " & StartInfo.Arguments)
  2340. Return Process.Start(StartInfo)
  2341. End Function
  2342. ''' <summary>
  2343. ''' 静默运行文件并返回输出流字符串。执行失败会抛出异常。
  2344. ''' </summary>
  2345. ''' <param name="FileName">文件名。可以为“notepad”等缩写。</param>
  2346. ''' <param name="Arguments">运行参数。</param>
  2347. ''' <param name="Timeout">等待该程序结束的最长时间(毫秒)。超时会抛出错误。</param>
  2348. Public Function StartProcessAndGetOutput(FileName As String, Optional Arguments As String = "", Optional Timeout As Integer = 1000000,
  2349. Optional WorkingDirectory As String = Nothing, Optional Encoding As Encoding = Nothing, Optional PrintLog As Boolean = True) As String
  2350. Dim Info = New ProcessStartInfo With {
  2351. .Arguments = Arguments,
  2352. .FileName = ShortenPath(FileName),
  2353. .UseShellExecute = False,
  2354. .CreateNoWindow = True,
  2355. .RedirectStandardError = True,
  2356. .RedirectStandardOutput = True,
  2357. .WorkingDirectory = ShortenPath(If(WorkingDirectory, Path.TrimEnd("\"c))),
  2358. .StandardErrorEncoding = Encoding,
  2359. .StandardOutputEncoding = Encoding
  2360. }
  2361. If WorkingDirectory IsNot Nothing Then
  2362. If Info.EnvironmentVariables.ContainsKey("appdata") Then
  2363. Info.EnvironmentVariables("appdata") = WorkingDirectory
  2364. Else
  2365. Info.EnvironmentVariables.Add("appdata", WorkingDirectory)
  2366. End If
  2367. End If
  2368. If PrintLog Then Log("[System] 执行命令并等待返回结果:" & FileName & " " & Arguments)
  2369. Using Program As New Process With {.StartInfo = Info}
  2370. Program.Start()
  2371. Dim Result As String = Program.StandardOutput.ReadToEnd & Program.StandardError.ReadToEnd
  2372. Program.WaitForExit(Timeout)
  2373. If Not Program.HasExited Then Program.Kill()
  2374. Return Result
  2375. End Using
  2376. End Function
  2377. ''' <summary>
  2378. ''' 在新的工作线程中执行代码。
  2379. ''' </summary>
  2380. Public Function RunInNewThread(Action As Action, Optional Name As String = Nothing, Optional Priority As ThreadPriority = ThreadPriority.Normal) As Thread
  2381. Dim th As New Thread(
  2382. Sub()
  2383. Try
  2384. Action()
  2385. Catch ex As ThreadInterruptedException
  2386. Log(Name & ":线程已中止")
  2387. Catch ex As Exception
  2388. Log(ex, Name & ":线程执行失败", LogLevel.Feedback)
  2389. End Try
  2390. End Sub) With {.Name = If(Name, "Runtime New Invoke " & GetUuid() & "#"), .Priority = Priority}
  2391. th.Start()
  2392. Return th
  2393. End Function
  2394. ''' <summary>
  2395. ''' 确保在 UI 线程中执行代码。
  2396. ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
  2397. ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
  2398. ''' </summary>
  2399. Public Function RunInUiWait(Of Output)(Action As Func(Of Output)) As Output
  2400. If RunInUi() Then
  2401. Return Action()
  2402. Else
  2403. Return Application.Current.Dispatcher.Invoke(Action)
  2404. End If
  2405. End Function
  2406. ''' <summary>
  2407. ''' 确保在 UI 线程中执行代码。
  2408. ''' 如果当前并非 UI 线程,则会阻断当前线程,直至 UI 线程执行完毕。
  2409. ''' 为防止线程互锁,请仅在开始加载动画、从 UI 获取输入时使用!
  2410. ''' </summary>
  2411. Public Sub RunInUiWait(Action As Action)
  2412. If RunInUi() Then
  2413. Action()
  2414. Else
  2415. Application.Current.Dispatcher.Invoke(Action)
  2416. End If
  2417. End Sub
  2418. ''' <summary>
  2419. ''' 确保在 UI 线程中执行代码,代码按触发顺序执行。
  2420. ''' 如果当前并非 UI 线程,也不阻断当前线程的执行。
  2421. ''' </summary>
  2422. Public Sub RunInUi(Action As Action, Optional ForceWaitUntilLoaded As Boolean = False)
  2423. If ForceWaitUntilLoaded Then
  2424. Application.Current.Dispatcher.InvokeAsync(Action, Threading.DispatcherPriority.Loaded)
  2425. ElseIf RunInUi() Then
  2426. Action()
  2427. Else
  2428. Application.Current.Dispatcher.InvokeAsync(Action)
  2429. End If
  2430. End Sub
  2431. ''' <summary>
  2432. ''' 确保在工作线程中执行代码。
  2433. ''' </summary>
  2434. Public Sub RunInThread(Action As Action)
  2435. If RunInUi() Then
  2436. RunInNewThread(Action, "Invoke " & GetUuid())
  2437. Else
  2438. Action()
  2439. End If
  2440. End Sub
  2441. ''' <summary>
  2442. ''' 选择最大值对应的对象。
  2443. ''' 若没有元素则返回 Nothing。
  2444. ''' </summary>
  2445. <Extension> Public Function MaxOf(Of T, C As IComparable(Of C))(Source As IEnumerable(Of T), Selector As Func(Of T, C)) As T
  2446. Using Enumerator = Source.GetEnumerator()
  2447. If Not Enumerator.MoveNext() Then Return Nothing
  2448. Dim MaxItem As T = Enumerator.Current
  2449. Dim MaxValue As C = Selector(MaxItem)
  2450. While Enumerator.MoveNext()
  2451. Dim Value = Selector(Enumerator.Current)
  2452. If Value.CompareTo(MaxValue) <= 0 Then Continue While
  2453. MaxItem = Enumerator.Current
  2454. MaxValue = Value
  2455. End While
  2456. Return MaxItem
  2457. End Using
  2458. End Function
  2459. ''' <summary>
  2460. ''' 选择最小值对应的对象。
  2461. ''' 若没有元素则返回 Nothing。
  2462. ''' </summary>
  2463. <Extension> Public Function MinOf(Of T, C As IComparable(Of C))(List As IEnumerable(Of T), Selector As Func(Of T, C)) As T
  2464. Using Enumerator = List.GetEnumerator()
  2465. If Not Enumerator.MoveNext() Then Return Nothing
  2466. Dim MinItem As T = Enumerator.Current
  2467. Dim MinValue As C = Selector(MinItem)
  2468. While Enumerator.MoveNext()
  2469. Dim Value = Selector(Enumerator.Current)
  2470. If Value.CompareTo(MinValue) >= 0 Then Continue While
  2471. MinItem = Enumerator.Current
  2472. MinValue = Value
  2473. End While
  2474. Return MinItem
  2475. End Using
  2476. End Function
  2477. ''' <summary>
  2478. ''' 按照既定的函数进行选择排序。
  2479. ''' 返回第一个对象是否应该排在前面(a > b)。
  2480. ''' </summary>
  2481. <Extension> Public Function SortByComparison(Of T)(List As IList(Of T), SortRule As ComparisonBoolean(Of T)) As List(Of T)
  2482. Dim NewList As New List(Of T)
  2483. While List.Any
  2484. Dim Highest = List(0)
  2485. For i = 1 To List.Count - 1
  2486. If SortRule(List(i), Highest) Then Highest = List(i)
  2487. Next
  2488. List.Remove(Highest)
  2489. NewList.Add(Highest)
  2490. End While
  2491. Return NewList
  2492. End Function
  2493. Public Delegate Function ComparisonBoolean(Of T)(Left As T, Right As T) As Boolean
  2494. ''' <summary>
  2495. ''' 返回列表的浅表副本。
  2496. ''' </summary>
  2497. <Extension> Public Function Clone(Of T)(list As IList(Of T)) As IList(Of T)
  2498. Return New List(Of T)(list)
  2499. End Function
  2500. ''' <summary>
  2501. ''' 尝试从字典中获取某项,如果该项不存在,则返回默认值。
  2502. ''' </summary>
  2503. <Extension> Public Function GetOrDefault(Of TKey, TValue)(Dict As IDictionary(Of TKey, TValue), Key As TKey, Optional DefaultValue As TValue = Nothing) As TValue
  2504. Dim Result As TValue
  2505. Return If(Dict.TryGetValue(Key, Result), Result, DefaultValue)
  2506. End Function
  2507. ''' <summary>
  2508. ''' 将某项添加到以列表作为值的字典中。
  2509. ''' </summary>
  2510. <Extension> Public Sub AddToList(Of TKey, TValue)(Dict As IDictionary(Of TKey, List(Of TValue)), Key As TKey, Value As TValue)
  2511. If Dict.ContainsKey(Key) Then
  2512. Dict(Key).Add(Value)
  2513. Else
  2514. Dict.Add(Key, New List(Of TValue) From {Value})
  2515. End If
  2516. End Sub
  2517. ''' <summary>
  2518. ''' 获取程序启动参数。
  2519. ''' </summary>
  2520. ''' <param name="Name">参数名。</param>
  2521. ''' <param name="DefaultValue">默认值。</param>
  2522. Public Function GetProgramArgument(Name As String, Optional DefaultValue As Object = "")
  2523. Dim AllArguments() As String = Command.Split(" ")
  2524. For i = 0 To AllArguments.Length - 1
  2525. If AllArguments(i) = "-" & Name Then
  2526. If AllArguments.Length = i + 1 OrElse AllArguments(i + 1).StartsWithF("-") Then Return True
  2527. Return AllArguments(i + 1)
  2528. End If
  2529. Next
  2530. Return DefaultValue
  2531. End Function
  2532. ''' <summary>
  2533. ''' 时间戳转化为日期。
  2534. ''' </summary>
  2535. Public Function GetDate(timeStamp As Integer) As Date
  2536. Dim dtStart As Date = TimeZone.CurrentTimeZone.ToLocalTime(New Date(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc))
  2537. Dim lTime As Long = (CLng(timeStamp) * 10000000)
  2538. Return dtStart.Add(New TimeSpan(lTime))
  2539. End Function
  2540. ''' <summary>
  2541. ''' 将 UTC 时间转化为当前时区的时间。
  2542. ''' </summary>
  2543. Public Function GetLocalTime(UtcDate As Date) As Date
  2544. Return DateTime.SpecifyKind(UtcDate, DateTimeKind.Utc).ToLocalTime
  2545. End Function
  2546. ''' <summary>
  2547. ''' 打开网页。
  2548. ''' </summary>
  2549. Public Sub OpenWebsite(Url As String)
  2550. Try
  2551. If Not Url.StartsWithF("http", True) AndAlso Not Url.StartsWithF("minecraft://", True) AndAlso Not Url.StartsWithF("minecraft-preview://", True) Then
  2552. Throw New Exception(Url & " 不是一个有效的网址,它必须以 http 开头!")
  2553. End If
  2554. Log("[System] 正在打开网页:" & Url)
  2555. StartProcess(Url)
  2556. Catch ex As Exception
  2557. Log(ex, "无法打开网页(" & Url & ")")
  2558. ClipboardSet(Url, False)
  2559. MyMsgBox("可能由于浏览器未正确配置,PCL 无法为你打开网页。" & vbCrLf & "网址已经复制到剪贴板,若有需要可以手动粘贴访问。" & vbCrLf &
  2560. $"网址:{Url}", "无法打开网页")
  2561. End Try
  2562. End Sub
  2563. ''' <summary>
  2564. ''' 打开 explorer。
  2565. ''' 若不以 \ 结尾,则将视作文件路径,打开并选中此文件。
  2566. ''' </summary>
  2567. Public Sub OpenExplorer(Location As String)
  2568. Try
  2569. Location = Location.Replace("/", "\").Trim(" "c, """"c)
  2570. Log("[System] 正在打开资源管理器:" & Location)
  2571. If Location.EndsWith("\") Then
  2572. StartProcess(Location)
  2573. Else
  2574. StartProcess("explorer", $"/select,""{Location}""")
  2575. End If
  2576. Catch ex As Exception
  2577. Log(ex, "打开资源管理器失败,请尝试关闭安全软件(如 360 安全卫士)", LogLevel.Msgbox)
  2578. End Try
  2579. End Sub
  2580. ''' <summary>
  2581. ''' 设置剪贴板。将在另一线程运行,且不会抛出异常。
  2582. ''' </summary>
  2583. Public Sub ClipboardSet(Text As String, Optional ShowSuccessHint As Boolean = True)
  2584. RunInThread(
  2585. Sub()
  2586. Dim RetryCount As Integer = 0
  2587. Retry:
  2588. Try
  2589. RunInUi(
  2590. Sub()
  2591. My.Computer.Clipboard.Clear()
  2592. If Not String.IsNullOrEmpty(Text) Then My.Computer.Clipboard.SetText(Text)
  2593. End Sub)
  2594. Catch ex As Exception
  2595. RetryCount += 1
  2596. If RetryCount <= 5 Then
  2597. Thread.Sleep(20)
  2598. GoTo Retry
  2599. Else
  2600. Log(ex, "可能由于剪贴板被其他程序占用,文本复制失败", LogLevel.Hint)
  2601. End If
  2602. End Try
  2603. If ShowSuccessHint Then Hint("已成功复制!", HintType.Green)
  2604. End Sub)
  2605. End Sub
  2606. ''' <summary>
  2607. ''' 获取剪贴板文本。将在 UI 线程运行,且不会抛出异常。
  2608. ''' </summary>
  2609. Public Function ClipboardGetText() As String
  2610. Dim Result As String = Nothing
  2611. RunInUiWait(
  2612. Sub()
  2613. Try
  2614. If My.Computer.Clipboard.ContainsText() Then Result = My.Computer.Clipboard.GetText()
  2615. Catch ex As Exception
  2616. Log(ex, "获取剪贴板文本失败")
  2617. End Try
  2618. End Sub)
  2619. Return Result
  2620. End Function
  2621. ''' <summary>
  2622. ''' 以 Byte() 形式获取程序中的资源。
  2623. ''' </summary>
  2624. Public Function GetResources(ResourceName As String) As Byte()
  2625. Log("[System] 获取资源:" & ResourceName)
  2626. Dim Raw As Byte() = My.Resources.ResourceManager.GetObject(ResourceName)
  2627. Return Raw
  2628. End Function
  2629. #End Region
  2630. #Region "UI"
  2631. '边距改变
  2632. ''' <summary>
  2633. ''' 相对增减控件的左边距。
  2634. ''' </summary>
  2635. Public Sub DeltaLeft(control As FrameworkElement, newValue As Double)
  2636. If TypeOf control Is Window Then
  2637. '窗口改变
  2638. CType(control, Window).Left += newValue
  2639. Else
  2640. '根据 HorizontalAlignment 改变数值
  2641. Select Case control.HorizontalAlignment
  2642. Case HorizontalAlignment.Left, HorizontalAlignment.Stretch
  2643. control.Margin = New Thickness(control.Margin.Left + newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom)
  2644. Case HorizontalAlignment.Right
  2645. control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right - newValue, control.Margin.Bottom)
  2646. 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom)
  2647. End Select
  2648. End If
  2649. End Sub
  2650. ''' <summary>
  2651. ''' 设置控件的左边距。(仅针对置左控件)
  2652. ''' </summary>
  2653. Public Sub SetLeft(control As FrameworkElement, newValue As Double)
  2654. control.Margin = New Thickness(newValue, control.Margin.Top, control.Margin.Right, control.Margin.Bottom)
  2655. End Sub
  2656. ''' <summary>
  2657. ''' 相对增减控件的上边距。
  2658. ''' </summary>
  2659. Public Sub DeltaTop(control As FrameworkElement, newValue As Double)
  2660. If TypeOf control Is Window Then
  2661. '窗口改变
  2662. CType(control, Window).Top += newValue
  2663. Else
  2664. '根据 VerticalAlignment 改变数值
  2665. Select Case control.VerticalAlignment
  2666. Case VerticalAlignment.Top
  2667. control.Margin = New Thickness(control.Margin.Left, control.Margin.Top + newValue, control.Margin.Right, control.Margin.Bottom)
  2668. Case VerticalAlignment.Bottom
  2669. control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, control.Margin.Bottom - newValue)
  2670. 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, CType(control.Parent, Object).ActualWidth - control.ActualWidth - newValue, control.Margin.Bottom)
  2671. End Select
  2672. End If
  2673. 'If Double.IsNaN(newValue) OrElse Double.IsInfinity(newValue) Then Return '安全性检查
  2674. 'Select Case control.VerticalAlignment
  2675. ' Case VerticalAlignment.Top, VerticalAlignment.Stretch, VerticalAlignment.Center
  2676. ' control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom)
  2677. ' Case VerticalAlignment.Bottom
  2678. ' control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, -newValue)
  2679. ' 'control.Margin = New Thickness(control.Margin.Left, control.Margin.Top, control.Margin.Right, CType(control.Parent, Object).ActualHeight - control.ActualHeight - newValue)
  2680. 'End Select
  2681. End Sub
  2682. ''' <summary>
  2683. ''' 设置控件的顶边距。(仅针对置上控件)
  2684. ''' </summary>
  2685. Public Sub SetTop(control As FrameworkElement, newValue As Double)
  2686. control.Margin = New Thickness(control.Margin.Left, newValue, control.Margin.Right, control.Margin.Bottom)
  2687. End Sub
  2688. 'DPI 转换
  2689. Public ReadOnly DPI As Integer = System.Drawing.Graphics.FromHwnd(IntPtr.Zero).DpiX
  2690. ''' <summary>
  2691. ''' 将经过 DPI 缩放的 WPF 尺寸转化为实际的像素尺寸。
  2692. ''' </summary>
  2693. Public Function GetPixelSize(WPFSize As Double) As Double
  2694. Return WPFSize / 96 * DPI
  2695. End Function
  2696. ''' <summary>
  2697. ''' 将实际的像素尺寸转化为经过 DPI 缩放的 WPF 尺寸。
  2698. ''' </summary>
  2699. Public Function GetWPFSize(PixelSize As Double) As Double
  2700. Return PixelSize * 96 / DPI
  2701. End Function
  2702. 'UI 截图
  2703. ''' <summary>
  2704. ''' 将某个控件的呈现转换为图片。
  2705. ''' </summary>
  2706. Public Function ControlBrush(UI As FrameworkElement) As ImageBrush
  2707. Dim Width = UI.ActualWidth, Height = UI.ActualHeight
  2708. If Width < 1 OrElse Height < 1 Then Return New ImageBrush
  2709. Dim bmp As New RenderTargetBitmap(GetPixelSize(Width), GetPixelSize(Height), DPI, DPI, PixelFormats.Pbgra32)
  2710. bmp.Render(UI)
  2711. Return New ImageBrush(bmp)
  2712. End Function
  2713. ''' <summary>
  2714. ''' 将某个控件的模拟呈现转换为图片。
  2715. ''' </summary>
  2716. Public Function ControlBrush(UI As FrameworkElement, Width As Double, Height As Double, Optional Left As Double = 0, Optional Top As Double = 0) As ImageBrush
  2717. UI.Measure(New Size(Width, Height))
  2718. UI.Arrange(New Rect(0, 0, Width, Height))
  2719. Dim bmp As New RenderTargetBitmap(GetPixelSize(Width), GetPixelSize(Height), DPI, DPI, PixelFormats.Default)
  2720. bmp.Render(UI)
  2721. If Not (Left = 0 AndAlso Top = 0) Then UI.Arrange(New Rect(Left, Top, Width, Height))
  2722. Return New ImageBrush(bmp)
  2723. End Function
  2724. ''' <summary>
  2725. ''' 将 UI 内容固定为图片并进行 Clear。
  2726. ''' </summary>
  2727. Public Sub ControlFreeze(UI As Panel)
  2728. UI.Background = ControlBrush(UI)
  2729. UI.Children.Clear()
  2730. End Sub
  2731. ''' <summary>
  2732. ''' 将 UI 内容固定为图片并进行 Clear。
  2733. ''' </summary>
  2734. Public Sub ControlFreeze(UI As Border)
  2735. UI.Background = ControlBrush(UI)
  2736. UI.Child = Nothing
  2737. End Sub
  2738. ''' <summary>
  2739. ''' 将 XML 转换为对应 UI 对象。
  2740. ''' 注意:性能较差,不应大量使用。
  2741. ''' </summary>
  2742. Public Function GetObjectFromXML(Str As XElement)
  2743. Return GetObjectFromXML(Str.ToString)
  2744. End Function
  2745. ''' <summary>
  2746. ''' 将 XML 转换为对应 UI 对象。
  2747. ''' 注意:性能较差,不应大量使用。
  2748. ''' </summary>
  2749. Public Function GetObjectFromXML(Str As String) As Object
  2750. Str = Str. '兼容旧版自定义事件写法
  2751. Replace("EventType=""", "local:CustomEventService.EventType=""").
  2752. Replace("EventData=""", "local:CustomEventService.EventData=""").
  2753. Replace("EventType='", "local:CustomEventService.EventType='").
  2754. Replace("EventData='", "local:CustomEventService.EventData='").
  2755. Replace("Property=""EventType""", "Property=""local:CustomEventService.EventType""").
  2756. Replace("Property=""EventData""", "Property=""local:CustomEventService.EventData""").
  2757. Replace("Property='EventType'", "Property='local:CustomEventService.EventType'").
  2758. Replace("Property='EventData'", "Property='local:CustomEventService.EventData'")
  2759. Using Stream As New MemoryStream(Encoding.UTF8.GetBytes(Str))
  2760. '类型检查
  2761. Using Reader As New XamlXmlReader(Stream)
  2762. While Reader.Read()
  2763. For Each BlackListType In {GetType(WebBrowser), GetType(Frame), GetType(MediaElement), GetType(ObjectDataProvider), GetType(XamlReader), GetType(Window), GetType(XmlDataProvider)}
  2764. If Reader.Type IsNot Nothing AndAlso BlackListType.IsAssignableFrom(Reader.Type.UnderlyingType) Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 类型。")
  2765. If Reader.Value IsNot Nothing AndAlso Reader.Value = BlackListType.Name Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListType.Name} 值。")
  2766. Next
  2767. For Each BlackListMember In {"Code", "FactoryMethod", "Static"}
  2768. If Reader.Member IsNot Nothing AndAlso Reader.Member.Name = BlackListMember Then Throw New UnauthorizedAccessException($"基于安全考虑,不允许使用 {BlackListMember} 成员。")
  2769. Next
  2770. End While
  2771. End Using
  2772. '实际的加载
  2773. Stream.Position = 0
  2774. Using Writer As New StreamWriter(Stream)
  2775. Writer.Write(Str)
  2776. Writer.Flush()
  2777. Stream.Position = 0
  2778. Return Markup.XamlReader.Load(Stream)
  2779. End Using
  2780. End Using
  2781. End Function
  2782. Private ReadOnly UiThreadId As Integer = Thread.CurrentThread.ManagedThreadId
  2783. ''' <summary>
  2784. ''' 当前线程是否为主线程。
  2785. ''' </summary>
  2786. Public Function RunInUi() As Boolean
  2787. Return Thread.CurrentThread.ManagedThreadId = UiThreadId
  2788. End Function
  2789. ''' <summary>
  2790. ''' 检查某个控件是否位于主窗口可视区域内,且控件本身可见。
  2791. ''' </summary>
  2792. <Extension> Public Function IsVisibleInForm(element As FrameworkElement) As Boolean
  2793. If Not element.IsVisible Then Return False
  2794. Dim bounds As Rect = element.TransformToAncestor(FrmMain).TransformBounds(New Rect(0, 0, element.ActualWidth, element.ActualHeight))
  2795. Dim rect As New Rect(0, 0, FrmMain.ActualWidth, FrmMain.ActualHeight)
  2796. Return rect.Contains(bounds.TopLeft) OrElse rect.Contains(bounds.BottomRight)
  2797. End Function
  2798. ''' <summary>
  2799. ''' 控件是否受到 TextTrimming 属性影响,导致内容被截取。
  2800. ''' </summary>
  2801. <Extension> Public Function IsTextTrimmed(Control As TextBlock) As Boolean
  2802. Control.Measure(New Size(Double.MaxValue, Double.MaxValue))
  2803. Return Control.DesiredSize.Width > Control.ActualWidth
  2804. End Function
  2805. ''' <summary>
  2806. ''' 获取文本在被渲染后的宽度。
  2807. ''' </summary>
  2808. Public Function MeasureStringWidth(text As String, Optional fontSize As Double = 14, Optional fontFamily As FontFamily = Nothing) As Double
  2809. If fontFamily Is Nothing Then fontFamily = New FontFamily("微软雅黑")
  2810. Dim formattedText = New FormattedText(
  2811. text, CultureInfo.CurrentCulture, FlowDirection.LeftToRight, New Typeface(fontFamily, FontStyles.Normal, FontWeights.Normal, FontStretches.Normal),
  2812. fontSize, Brushes.Black, New NumberSubstitution(), TextFormattingMode.Display, New DpiScale(1, 1).PixelsPerDip)
  2813. Return formattedText.Width
  2814. End Function
  2815. #End Region
  2816. #Region "Debug"
  2817. Public ModeDebug As Boolean = False
  2818. 'Log
  2819. Public Enum LogLevel
  2820. ''' <summary>
  2821. ''' 不提示,只记录日志。
  2822. ''' </summary>
  2823. Normal = 0
  2824. ''' <summary>
  2825. ''' 只提示开发者。
  2826. ''' </summary>
  2827. Developer = 1
  2828. ''' <summary>
  2829. ''' 只提示开发者与调试模式用户。
  2830. ''' </summary>
  2831. Debug = 2
  2832. ''' <summary>
  2833. ''' 弹出提示所有用户。
  2834. ''' </summary>
  2835. Hint = 3
  2836. ''' <summary>
  2837. ''' 弹窗,不要求反馈。
  2838. ''' </summary>
  2839. Msgbox = 4
  2840. ''' <summary>
  2841. ''' 弹窗,要求反馈。
  2842. ''' </summary>
  2843. Feedback = 5
  2844. ''' <summary>
  2845. ''' 弹出 Windows 原生弹窗,要求反馈。在无法保证 WPF 窗口能正常运行时使用此级别。
  2846. ''' 在第二次触发后会直接结束程序。
  2847. ''' </summary>
  2848. Critical = 6
  2849. End Enum
  2850. Private LogList As New StringBuilder
  2851. Private LogWritter As StreamWriter
  2852. Public Sub LogStart()
  2853. RunInNewThread(
  2854. Sub()
  2855. Dim IsInitSuccess As Boolean = True
  2856. Try
  2857. For i = 4 To 1 Step -1
  2858. If File.Exists(Path & "PCL\Log" & i & ".txt") Then
  2859. If File.Exists(Path & "PCL\Log" & (i + 1) & ".txt") Then File.Delete(Path & "PCL\Log" & (i + 1) & ".txt")
  2860. CopyFile(Path & "PCL\Log" & i & ".txt", Path & "PCL\Log" & (i + 1) & ".txt")
  2861. End If
  2862. Next
  2863. File.Create(Path & "PCL\Log1.txt").Dispose()
  2864. Catch ex As IOException
  2865. IsInitSuccess = False
  2866. Hint("可能同时开启了多个 PCL,程序可能会出现未知问题!", HintType.Red)
  2867. Log(ex, "日志初始化失败(疑似文件占用问题)")
  2868. Catch ex As Exception
  2869. IsInitSuccess = False
  2870. Log(ex, "日志初始化失败", LogLevel.Hint)
  2871. End Try
  2872. Try
  2873. LogWritter = New StreamWriter(Path & "PCL\Log1.txt", True) With {.AutoFlush = True}
  2874. Catch ex As Exception
  2875. LogWritter = Nothing
  2876. Log(ex, "日志写入失败", LogLevel.Hint)
  2877. End Try
  2878. While True
  2879. If IsInitSuccess Then
  2880. LogFlush()
  2881. Else
  2882. LogList = New StringBuilder '清空 LogList 避免内存爆炸
  2883. End If
  2884. Thread.Sleep(50)
  2885. End While
  2886. End Sub, "Log Writer", ThreadPriority.Lowest)
  2887. End Sub
  2888. Private ReadOnly LogFlushLock As New Object '防止外部调用 LogFlush 时同时输出多次日志
  2889. Public Sub LogFlush()
  2890. On Error Resume Next
  2891. If LogWritter Is Nothing Then Return
  2892. Dim Log As String = Nothing
  2893. SyncLock LogFlushLock
  2894. If LogList.Length > 0 Then
  2895. Dim LogListCache As StringBuilder
  2896. LogListCache = LogList
  2897. LogList = New StringBuilder
  2898. Log = LogListCache.ToString
  2899. End If
  2900. End SyncLock
  2901. If Log IsNot Nothing Then
  2902. LogWritter.Write(Log)
  2903. End If
  2904. End Sub
  2905. Private ReadOnly LogListLock As New Object '防止日志乱码,只在调试模式下启用
  2906. Private IsCriticalErrorTriggered As Boolean = False
  2907. ''' <summary>
  2908. ''' 输出 Log。
  2909. ''' </summary>
  2910. ''' <param name="Title">如果要求弹窗,指定弹窗的标题。</param>
  2911. Public Sub Log(Text As String, Optional Level As LogLevel = LogLevel.Normal, Optional Title As String = "出现错误")
  2912. On Error Resume Next
  2913. '放在最后会导致无法显示极端错误下的弹窗(如无法写入日志文件)
  2914. '处理错误会导致再次调用 Log() 导致无限循环
  2915. '输出日志
  2916. Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Text}{vbCrLf}" '减轻同步锁占用
  2917. AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
  2918. If ModeDebug Then
  2919. SyncLock LogListLock
  2920. LogList.Append(AppendText)
  2921. End SyncLock
  2922. Else
  2923. LogList.Append(AppendText)
  2924. End If
  2925. #If DEBUG Then
  2926. Console.Write(AppendText)
  2927. #End If
  2928. If IsProgramEnded OrElse Level = LogLevel.Normal Then Return
  2929. '去除前缀
  2930. Text = Text.RegexReplace("\[[^\]]+?\] ", "")
  2931. '输出提示
  2932. Select Case Level
  2933. #If DEBUG Then
  2934. Case LogLevel.Developer
  2935. Hint("[开发者模式] " & Text, HintType.Blue, False)
  2936. Case LogLevel.Debug
  2937. Hint("[调试模式] " & Text, HintType.Blue, False)
  2938. #Else
  2939. Case LogLevel.Developer
  2940. Case LogLevel.Debug
  2941. If ModeDebug Then Hint("[调试模式] " & Text, HintType.Blue, False)
  2942. #End If
  2943. Case LogLevel.Hint
  2944. Hint(Text, HintType.Red, False)
  2945. Case LogLevel.Msgbox
  2946. MyMsgBox(Text, Title, IsWarn:=True)
  2947. Case LogLevel.Feedback
  2948. If CanFeedback(False) Then
  2949. If MyMsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
  2950. Else
  2951. MyMsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
  2952. End If
  2953. Case LogLevel.Critical
  2954. If IsCriticalErrorTriggered Then
  2955. FormMain.EndProgramForce(ProcessReturnValues.Exception)
  2956. Return
  2957. End If
  2958. IsCriticalErrorTriggered = True
  2959. If CanFeedback(False) Then
  2960. If MsgBox(Text & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
  2961. Else
  2962. MsgBox(Text & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
  2963. End If
  2964. End Select
  2965. '上报
  2966. If Level >= LogLevel.Hint Then
  2967. Telemetry("PCL 错误",
  2968. "Level", GetStringFromEnum(Level),
  2969. "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"),
  2970. "Exception", FilterUserName(FilterAccessToken(Text, "*"), "*"))
  2971. End If
  2972. End Sub
  2973. ''' <summary>
  2974. ''' 输出错误信息。
  2975. ''' </summary>
  2976. ''' <param name="Desc">错误描述。会在处理时在末尾加入冒号。</param>
  2977. Public Sub Log(Ex As Exception, Desc As String, Optional Level As LogLevel = LogLevel.Debug, Optional Title As String = "出现错误")
  2978. On Error Resume Next
  2979. If TypeOf Ex Is ThreadInterruptedException Then Return
  2980. '获取错误信息
  2981. Dim ExFull As String = $"{Desc}:{Ex.GetDetail()}"
  2982. '输出日志
  2983. Dim AppendText As String = $"[{GetTimeNow()}] <{If(Thread.CurrentThread.Name = "", "主线程", Thread.CurrentThread.Name)}> {Desc}:{Ex.GetDetail(True)}{vbCrLf}" '减轻同步锁占用
  2984. AppendText = FilterUserName(FilterAccessToken(AppendText, "*"), "*")
  2985. If ModeDebug Then
  2986. SyncLock LogListLock
  2987. LogList.Append(AppendText)
  2988. End SyncLock
  2989. Else
  2990. LogList.Append(AppendText)
  2991. End If
  2992. #If DEBUG Then
  2993. Console.Write(AppendText)
  2994. #End If
  2995. If IsProgramEnded Then Return
  2996. '输出提示
  2997. Select Case Level
  2998. Case LogLevel.Normal
  2999. #If DEBUG Then
  3000. Case LogLevel.Developer
  3001. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  3002. Hint("[开发者模式] " & ExLine, HintType.Blue, False)
  3003. Case LogLevel.Debug
  3004. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  3005. Hint("[调试模式] " & ExLine, HintType.Blue, False)
  3006. #Else
  3007. Case LogLevel.Developer
  3008. Case LogLevel.Debug
  3009. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  3010. If ModeDebug Then Hint("[调试模式] " & ExLine, HintType.Blue, False)
  3011. #End If
  3012. Case LogLevel.Hint
  3013. Dim ExLine As String = Desc & ":" & Ex.GetBrief()
  3014. Hint(ExLine, HintType.Red, False)
  3015. Case LogLevel.Msgbox
  3016. MyMsgBox(ExFull, Title, IsWarn:=True)
  3017. Case LogLevel.Feedback
  3018. If CanFeedback(False) Then
  3019. If MyMsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", Title, "反馈", "取消", IsWarn:=True) = 1 Then Feedback(False, True)
  3020. Else
  3021. MyMsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", Title, IsWarn:=True)
  3022. End If
  3023. Case LogLevel.Critical
  3024. If IsCriticalErrorTriggered Then
  3025. FormMain.EndProgramForce(ProcessReturnValues.Exception)
  3026. Return
  3027. End If
  3028. IsCriticalErrorTriggered = True
  3029. If CanFeedback(False) Then
  3030. If MsgBox(ExFull & vbCrLf & vbCrLf & "是否反馈此问题?如果不反馈,这个问题可能永远无法得到解决!", MsgBoxStyle.Critical + MsgBoxStyle.YesNo, Title) = MsgBoxResult.Yes Then Feedback(False, True)
  3031. Else
  3032. MsgBox(ExFull & vbCrLf & vbCrLf & "将 PCL 更新至最新版或许可以解决这个问题……", MsgBoxStyle.Critical, Title)
  3033. End If
  3034. End Select
  3035. '上报
  3036. If Level >= LogLevel.Hint Then
  3037. Telemetry("PCL 异常",
  3038. "Level", GetStringFromEnum(Level),
  3039. "Title", FilterUserName(FilterAccessToken(Title, "*"), "*"),
  3040. "Exception", FilterUserName(FilterAccessToken(ExFull, "*"), "*"))
  3041. End If
  3042. End Sub
  3043. '反馈
  3044. Public Sub Feedback(Optional ShowMsgbox As Boolean = True, Optional ForceOpenLog As Boolean = False)
  3045. On Error Resume Next
  3046. FeedbackInfo()
  3047. If ForceOpenLog OrElse (ShowMsgbox AndAlso MyMsgBox("若你在汇报一个 Bug,请点击 打开文件夹 按钮,并上传 Log(1~5).txt 中包含错误信息的文件。" & vbCrLf & "游戏崩溃一般与启动器无关,请不要因为游戏崩溃而提交反馈。", "反馈提交提醒", "打开文件夹", "不需要") = 1) Then
  3048. OpenExplorer(Path & "PCL\Log1.txt")
  3049. End If
  3050. OpenWebsite("https://github.com/Meloong-Git/PCL/issues/")
  3051. End Sub
  3052. Public Function CanFeedback(ShowHint As Boolean) As Boolean
  3053. If False.Equals(PageSetupSystem.IsLauncherNewest) Then
  3054. If ShowHint Then
  3055. If MyMsgBox($"你的 PCL 不是最新版,因此无法提交反馈。{vbCrLf}请在更新后,确认该问题在最新版中依然存在,然后再提交反馈。", "无法提交反馈", "更新", "取消") = 1 Then
  3056. UpdateCheckByButton()
  3057. End If
  3058. End If
  3059. Return False
  3060. Else
  3061. Return True
  3062. End If
  3063. End Function
  3064. ''' <summary>
  3065. ''' 在日志中输出系统诊断信息。
  3066. ''' </summary>
  3067. Public Sub FeedbackInfo()
  3068. On Error Resume Next
  3069. Log("[System] 诊断信息:" & vbCrLf &
  3070. "操作系统:" & My.Computer.Info.OSFullName & "(32 位:" & Is32BitSystem & ")" & vbCrLf &
  3071. "剩余内存:" & Int(My.Computer.Info.AvailablePhysicalMemory / 1024 / 1024) & " M / " & Int(My.Computer.Info.TotalPhysicalMemory / 1024 / 1024) & " M" & vbCrLf &
  3072. "DPI:" & DPI & "(" & Math.Round(DPI / 96, 2) * 100 & "%)" & vbCrLf &
  3073. "MC 文件夹:" & If(McFolderSelected, "Nothing") & vbCrLf &
  3074. "文件位置:" & Path)
  3075. End Sub
  3076. '遥测
  3077. Public Sub Telemetry([Event] As String, ParamArray Datas As String())
  3078. If Not Setup.Get("SystemSystemTelemetry") Then Return '用户关闭了遥测
  3079. If Not ClsBaseUrl.StartsWithF("http") Then Return '开源版没有设置遥测地址
  3080. If VersionBranchName = "Debug" Then Return '开发版本不上传遥测
  3081. RunInNewThread(
  3082. Sub()
  3083. Try
  3084. Log($"[System] 匿名数据上报:{[Event]}")
  3085. Dim Url As String = $"{ClsBaseUrl}&Event={WebUtility.UrlEncode([Event])}"
  3086. For i = 0 To Datas.Length - 1 Step 2
  3087. Url &= "&" & WebUtility.UrlEncode(Datas(i)) & "=" & WebUtility.UrlEncode(Datas(i + 1).Replace(vbCrLf, vbLf))
  3088. Next
  3089. NetRequestByClient(Url, MakeLog:=False)
  3090. Catch ex As Exception
  3091. Log(ex, "匿名数据上报失败")
  3092. End Try
  3093. End Sub, "Telemetry", ThreadPriority.Lowest)
  3094. End Sub
  3095. '获取当前的堆栈信息
  3096. Public Function GetStackTrace() As String
  3097. Dim Stack As New StackTrace()
  3098. Return Join(Stack.GetFrames().Skip(1).Select(Function(f) f.GetMethod).
  3099. Select(Function(f) f.Name & "(" & Join(f.GetParameters.Select(Function(p) p.ToString).ToList, ", ") & ") - " & f.Module.ToString).ToList,
  3100. vbCrLf).Replace(vbCrLf & vbCrLf, vbCrLf)
  3101. End Function
  3102. #End Region
  3103. #Region "随机"
  3104. Private ReadOnly Random As New Random
  3105. ''' <summary>
  3106. ''' 随机选择其一。
  3107. ''' </summary>
  3108. Public Function RandomOne(Of T)(objects As ICollection(Of T)) As T
  3109. Return objects(RandomInteger(0, objects.Count - 1))
  3110. End Function
  3111. ''' <summary>
  3112. ''' 取随机整数(包含)。
  3113. ''' </summary>
  3114. Public Function RandomInteger(min As Integer, max As Integer) As Integer
  3115. Return Math.Floor((max - min + 1) * Random.NextDouble) + min
  3116. End Function
  3117. ''' <summary>
  3118. ''' 将数组随机打乱。
  3119. ''' </summary>
  3120. <Extension> Public Iterator Function Shuffle(Of T)(Raw As IEnumerable(Of T)) As IEnumerable(Of T)
  3121. Dim RawCopy As New List(Of T)(Raw)
  3122. Do While RawCopy.Any
  3123. Dim i As Integer = RandomInteger(0, RawCopy.Count - 1)
  3124. Yield RawCopy(i)
  3125. RawCopy.RemoveAt(i)
  3126. Loop
  3127. End Function
  3128. #End Region
  3129. End Module
  3130. #Region "WPF"
  3131. ''' <summary>
  3132. ''' 对数据绑定进行加法运算,使用参数决定加数。
  3133. ''' </summary>
  3134. Public Class AdditionConverter
  3135. Implements IValueConverter
  3136. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  3137. If value Is Nothing Then Return 0
  3138. Dim before As Double
  3139. If Not Double.TryParse(value.ToString(), before) Then Return 0
  3140. Dim scale As Double = 1
  3141. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  3142. Return before + scale
  3143. End Function
  3144. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  3145. If value Is Nothing Then Return Binding.DoNothing
  3146. Dim before As Double
  3147. If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
  3148. Dim scale As Double = 1
  3149. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  3150. If scale = 0 Then Return Binding.DoNothing
  3151. Return before - scale
  3152. End Function
  3153. End Class
  3154. ''' <summary>
  3155. ''' 对数据绑定进行乘法运算,使用参数决定乘数。
  3156. ''' </summary>
  3157. Public Class MultiplicationConverter
  3158. Implements IValueConverter
  3159. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  3160. If value Is Nothing Then Return 0
  3161. Dim before As Double
  3162. If Not Double.TryParse(value.ToString(), before) Then Return 0
  3163. Dim scale As Double = 1
  3164. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  3165. Return before * scale
  3166. End Function
  3167. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  3168. If value Is Nothing Then Return Binding.DoNothing
  3169. Dim before As Double
  3170. If Not Double.TryParse(value.ToString(), before) Then Return Binding.DoNothing
  3171. Dim scale As Double = 1
  3172. If parameter IsNot Nothing Then Double.TryParse(parameter.ToString(), scale)
  3173. If scale = 0 Then Return Binding.DoNothing
  3174. Return before / scale
  3175. End Function
  3176. End Class
  3177. ''' <summary>
  3178. ''' 将取反的 Boolean 绑定到 Visibility。
  3179. ''' </summary>
  3180. Public Class InverseBooleanToVisibilityConverter
  3181. Implements IValueConverter
  3182. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  3183. If value Is Nothing Then Return Visibility.Visible
  3184. Dim boolValue As Boolean
  3185. Return If(Boolean.TryParse(value.ToString(), boolValue), If(boolValue, Visibility.Collapsed, Visibility.Visible), Visibility.Visible)
  3186. End Function
  3187. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  3188. If value Is Nothing Then Return False
  3189. Return If(TypeOf value Is Visibility, value <> Visibility.Visible, False)
  3190. End Function
  3191. End Class
  3192. ''' <summary>
  3193. ''' 将 Boolean 取反。
  3194. ''' </summary>
  3195. Public Class InverseBooleanConverter
  3196. Implements IValueConverter
  3197. Public Function Convert(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.Convert
  3198. If value Is Nothing Then Return False
  3199. Dim boolValue As Boolean
  3200. Return If(Boolean.TryParse(value.ToString(), boolValue), Not boolValue, False)
  3201. End Function
  3202. Public Function ConvertBack(value As Object, targetType As Type, parameter As Object, culture As CultureInfo) As Object Implements IValueConverter.ConvertBack
  3203. If value Is Nothing Then Return False
  3204. Return If(Boolean.TryParse(value.ToString(), value), Not value, False)
  3205. End Function
  3206. End Class
  3207. #End Region