FUNCTION DayStr$ (D%)
  CONST DG = "十一二三四五六七八九"
  SELECT CASE D%
      CASE 10: v$ = "初十"
      CASE 20: v$ = "二十"
      CASE ELSE
           N% = D% MOD 10
           v$ = MID$(DG, N% + N% + 1, 2)
           N% = INT(D% / 10)
           v$ = MID$("初十廿三", N% + N% + 1, 2) + v$
  END SELECT
  DayStr$ = v$
END FUNCTION

FUNCTION gStr$ (X%)
  gStr$ = MID$("癸甲乙丙丁戊己庚辛壬", (X% MOD 10) * 2 + 1, 2)
END FUNCTION

FUNCTION gzDay (Y%, M%, D%, Hour%)
   '返回日的干支(干=mod 10 支=mod 12)
   IF Hour% < 23 THEN
         gzD& = Begin2Date(Y%, M%, D%)
      ELSE
         gzD& = Begin2Date(Y%, M%, D%) + 1
   END IF
   gzDay% = (gzD& + 15) MOD 60
END FUNCTION

FUNCTION gzHour% (Y%, M%, D%, h%)
   '时干支(干=mod 10 支=mod 12)
   z% = (h% + 3) \ 2 MOD 12
   g% = gzDay(Y%, M%, D%, h%) MOD 10
   g% = ((g% + 10) * 2 - 1) MOD 10
   g% = (g% + z% - 1) MOD 10
   FOR I% = 0 TO 59
      IF (I% MOD 10 = g%) AND (I% MOD 12 = z%) THEN
         gzHour% = I%: EXIT FUNCTION
      END IF
   NEXT
END FUNCTION

FUNCTION gzMonth% (Y%, M%, D%, Hour%, Minute%)
   '取月干支(干=mod 10 支=mod 12)
   '自当前日期向前扫描,(当前日期<节气日期)
   STATIC TmpY%, TmpM%, TmpD%, TmpH%, TmpMin%, TmpV%
   IF TmpY% = Y% AND TmpM% = M% AND TmpD% = D% AND TmpH% = Hour% THEN
      gzMonth% = TmpV%: EXIT FUNCTION
   END IF
   TmpY% = Y%: TmpM% = M%: TmpD% = D%: TmpH% = Hour%: TmpMin% = Minute%

   vTime# = Date2year(Y%, M%, D%) + Hour% / 24 + Minute% / 1440#
   vM% = M%: vY% = Y%
   DO
      N# = Date2JQ(vY%, vM% * 2 - 1)
      vM% = vM% - 1
      IF vM% < 1 THEN vM% = 12: vY% = vY% - 1
   LOOP WHILE vTime# < N#
   g% = gzyear(Y%, M%, D%, Hour%, Minute%) MOD 10
   g% = ((g% + 11) * 2 - 1) MOD 10
   g% = (g% + vM% - 1) MOD 10
   z% = (vM% + 2) MOD 12
   FOR I% = 0 TO 59
      IF (I% MOD 10 = g%) AND (I% MOD 12 = z%) THEN
         TmpV% = I%: EXIT FOR
      END IF
   NEXT
   gzMonth% = TmpV%
END FUNCTION

FUNCTION gzNaYin$ (g%, z%)
   '六十甲子纳音
   STATIC Lc%, NaYin() AS STRING * 36
   IF Lc% = 0 THEN
      Lc% = 1: REDIM NaYin(5) AS STRING * 36
      NaYin(0) = "海中金大溪水佛灯火沙中金泉中水山头火"
      NaYin(1) = "涧下水炉中火沙中土天河水山下火屋上土"
      NaYin(2) = "霹雳火城墙土大林木天上火大驿土平地木"
      NaYin(3) = "壁上土松柏木白腊金路旁土石榴木钗钏金"
      NaYin(4) = "桑松木金泊金长流水杨柳木剑锋金大海水"
   END IF
   IF g% = 0 THEN N% = 10 ELSE N% = g%
   K1% = INT((N% - 1) / 2)
   IF z% = 0 THEN N% = 12 ELSE N% = z%
   K2% = INT((N% - 1) / 2)
   gzNaYin$ = MID$(NaYin(K1%), K2% * 6 + 1, 6)
END FUNCTION

FUNCTION gzYear% (Y%, M%, D%, Hour%, Minute%)
   '返回年的干支(干=mod 10 支=mod 12)
   M# = Date2JQ(Y%, 3)
   K# = Date2year(Y%, M%, D%) + Hour% / 24 + Minute% / 1440
   IF M# > K# THEN gzyear% = (Y% + 56) MOD 60 ELSE gzyear% = (Y% + 57) MOD 60
END FUNCTION

FUNCTION IsLeapYear% (Y%)
   IsLeapYear% = ((Y% MOD 4 = 0) AND (Y% MOD 100 <> 0)) OR (Y% MOD 400 = 0)
END FUNCTION

FUNCTION JQStr$ (N%)
   CONST JName = "小寒大寒立春雨水惊蛰春分清明谷雨立夏小满芒种夏至小暑大暑立秋处暑白露秋分寒露霜降立冬小雪大雪冬至"
   JQStr$ = MID$(JName, (N% - 1) * 4 + 1, 4)
END FUNCTION

SUB LunDate (Y%, M%, D%, LunY%, LunM%, LunD%)
   '返回 公历 Y年 M月 D日的农历日期 
   'LunY=年 LunM=月 LunD=日
   STATIC TmpY AS INTEGER, TmpM AS INTEGER, TmpD AS INTEGER
   STATIC TmpDay AS INTEGER, TmpMonth AS INTEGER, TmpYear AS INTEGER

   IF TmpY = Y% AND TmpM = M% AND TmpD = D% THEN
      LunY% = TmpYear%: LunM% = TmpMonth%: LunD% = TmpDay%: EXIT SUB
   END IF
   TmpY = Y%: TmpM = M%: TmpD = D%
   IF Y% < 1901 OR Y% > 2099 THEN EXIT SUB      '----超出范围则退出

   CALL WnlData(Y%, vM%, vD%, Leap%, MaxMin%)   '取农历数据

   TmpYear% = Y%
   TmpDay% = Date2year(TmpYear%, M%, D%) - Date2year(TmpYear%, vM%, vD%) + 1
   IF TmpDay% < 1 THEN                             '在上一年
      TmpYear% = Y% - 1
      CALL WnlData(TmpYear%, vM%, vD%, Leap%, MaxMin%)
      TmpDay% = Date2year(Y%, M%, D%) + Date2year(TmpYear%, 12, 31) - Date2year(TmpYear%, vM%, vD%) + 1
   END IF
   '---------------------------------------------------------

   TmpMonth% = 1: MM% = 1
   IF (MM% AND MaxMin%) <> 0 THEN MonthDays% = 30 ELSE MonthDays% = 29
   DO                    '取得农历月 和 日
      IF TmpDay% - MonthDays% > 0 THEN
         TmpDay% = TmpDay% - MonthDays%
         TmpMonth% = TmpMonth% + 1
      END IF
      MM% = MM% * 2
      IF (MM% AND MaxMin%) <> 0 THEN MonthDays% = 30 ELSE MonthDays% = 29
   LOOP WHILE TmpDay% - MonthDays% > 0

   IF Leap% > 0 THEN    '如果今年是闰年
      IF TmpMonth% > Leap% THEN
         TmpMonth% = TmpMonth% - 1
         IF TmpMonth% = Leap% THEN TmpMonth% = TmpMonth% * -1
      END IF
   END IF
   
   LunY% = TmpYear%
   LunM% = TmpMonth%
   LunD% = TmpDay%
END SUB

FUNCTION Monthstr$ (M%)
  CONST DG = "正二三四五六七八九十"
  IF M% < 0 THEN v$ = "闰"
  N% = ABS(M%)
  SELECT CASE N%
         CASE 11: v$ = v$ + "十一"
         CASE 12: v$ = v$ + "十二"
         CASE ELSE
              v$ = v$ + MID$(DG, N% + N% - 1, 2)
  END SELECT
  Monthstr$ = v$
END FUNCTION

FUNCTION NonDay% (Y%, M%, D%)
   CALL LunDate(Y%, M%, D%, vY%, vM%, vD%)
   NonDay% = vD%
END FUNCTION

FUNCTION NonMonth% (Y%, M%, D%)
   CALL LunDate(Y%, M%, D%, vY%, vM%, vD%)
   NonMonth% = vM%
END FUNCTION

FUNCTION NonYear% (Y%, M%, D%)
   CALL LunDate(Y%, M%, D%, vY%, vM%, vD%)
   NonYear% = vY%
END FUNCTION

FUNCTION SXStr$ (X%)
   SXStr$ = MID$("猪鼠牛虎兔龙蛇马羊猴鸡狗", X% + X% + 1, 2)
END FUNCTION

FUNCTION week% (Y%, M%, D%)
   '星期
   week% = Begin2Date(Y%, M%, D%) MOD 7
END FUNCTION

SUB WnlData (Y%, M%, D%, Leap%, Month%)
   '万年历数据 (公元1901-2099年)
   '每年为3字节 0-4公历日(1-31)，5-6公历月(0=1，1=2，2=3),7-19农历大
   '小月,20-23农历闰月(0无闰 <>0闰月)
   'M=月 D=日 Leap=闰 Month=农历大小月(0=29 1=30)

   IF Y% < 1901 OR Y% > 2099 THEN EXIT SUB'超出数据则退出
   STATIC Lc AS INTEGER                '初始化数据标志
   STATIC wnl() AS INTEGER             '数据数组
   
   IF Lc = 0 THEN
      Lc = 1: REDIM wnl(1901 TO 2099, 4) AS INTEGER

      Dt$ = Dt$ + "04AE530A57485526BD0D26500D954446AAB9056A4D09AD4224AEB604AE4A"'1901-1911
      Dt$ = Dt$ + "6A4DBE0A4D520D25465D52BA0B544E0D6A43296D37095B4B749BC1049754"'1911-1921
      Dt$ = Dt$ + "0A4B485B25BC06A55006D4454ADAB802B64D0957422497B704974A664B3E"'1921-1931
      Dt$ = Dt$ + "0D4A510EA54656D4BA05AD4E02B644393738092E4B7C96BF0C95530D4A48"'1931-1941
      Dt$ = Dt$ + "6DA53B0B554F056A454AADB9025D4D092D422C95B60A954A7B4ABD06CA51"'1941-1951
      Dt$ = Dt$ + "0B5546555ABB04DA4E0A5B43352BB8052B4C8A953F0E955206AA487AD53C"'1951-1961
      Dt$ = Dt$ + "0AB54F04B6454A57390A574D0526423E93350D954975AABE056A51096D46"'1961-1971
      Dt$ = Dt$ + "54AEBB04AD4F0A4D434D26B70D254B8D52BF0B54520B6A47696D3C095B50"'1971-1981
      Dt$ = Dt$ + "049B454A4BB90A4B4DAB25C206A55406D4496ADA3D0AB6510937465497BB"'1981-1991
      Dt$ = Dt$ + "04974F064B4436A5370EA54A86B2BF05AC530AB6475936BC092E500C9645"'1991-2001
      Dt$ = Dt$ + "4D4AB80D4A4C0DA54125AAB6056A497AADBD025D52092D475C95BA0A954E"'2001-2011
      Dt$ = Dt$ + "0B4A434B55370AD54A955ABF04BA530A5B48652BBC052B500A9345474AB9"'2011-2021
      Dt$ = Dt$ + "06AA4C0AD54124DAB604B64A69573D0A4E510D26465E933A0D534D05AA43"'2021-2031
      Dt$ = Dt$ + "36B537096D4BB4AEBF04AD530A4D486D25BC0D254F0D52445DAA380B5A4C"'2031-2041
      Dt$ = Dt$ + "056D4124ADB6049B4A7A4BBE0A4B510AA5465B52BA06D24E0ADA42355B37"'2041-2051
      Dt$ = Dt$ + "09374B8497C1049753064B4866A53C0EA54F06B2444AB6380AAE4C092E42"'2051-2061
      Dt$ = Dt$ + "3C97350C96497D4ABD0D4A510DA54555AABA056A4E0A6D43452EB7052D4B"'2061-2071
      Dt$ = Dt$ + "8A95BF0A95530B4A476B553B0AD54F055A454A5D380A5B4C052B423A93B6"'2071-2081
      Dt$ = Dt$ + "0693497729BD06AA510AD54654DABA04B64E0A57434527380D264A8E933E"'2081-2091
      Dt$ = Dt$ + "0D52520DAA4766B53B056D4F04AE454A4EB90A4D4C0D15412D92B5"      '2091-2099
        
      DIM K(3) AS INTEGER
      T$ = "123456789ABCDEF"     '十六进制 0-15  '1 256 65536
      FOR I% = 1901 TO 2099       '取数据转化成Long值
          aa$ = MID$(Dt$, (I% - 1901) * 6 + 1, 6)
          FOR J% = 0 TO 2
              ab$ = MID$(aa$, J% * 2 + 1, 2)
              K(J%) = INSTR(T$, LEFT$(ab$, 1)) * 16 + INSTR(T$, RIGHT$(ab$, 1))
          NEXT
          W& = K(0) * 65536 + K(1) * 256& + K(2)
          
          bit& = 1: Sum% = 0: C% = 1
          FOR J% = 1 TO 5
             IF (bit& AND W&) <> 0 THEN Sum% = Sum% + C%
             bit& = bit& +Bit&: C% = C% +C%
          NEXT
          wnl(I%, 1) = Sum%
          
          bit& = 2 ^ 5: Sum% = 0: C% = 1
          FOR J% = 1 TO 2
             IF (bit& AND W&) <> 0 THEN Sum% = Sum% + C%
             bit& = bit&  +Bit&: C% = C% +C%
          NEXT
          wnl(I%, 0) = Sum%
          
          Sum% = 0: C% = 1: bit& = 2 ^ 19
          FOR J% = 1 TO 13
             IF (bit& AND W&) <> 0 THEN Sum% = Sum% + C%
             bit& = bit& / 2: C% = C% +C%
          NEXT
          wnl(I%, 3) = Sum%
          
          Sum% = 0: C% = 1: bit& = 2 ^ 20
          FOR J% = 1 TO 4
             IF (bit& AND W&) <> 0 THEN Sum% = Sum% + C%
             bit& = bit&  +Bit&: C% = C% +C%
          NEXT
          wnl(I%, 2) = Sum%
      NEXT
      Dt$ = ""
   END IF
   M% = wnl(Y%, 0)
   D% = wnl(Y%, 1)
   Leap% = wnl(Y%, 2)
   Month% = wnl(Y%, 3)
END SUB

FUNCTION WStr$ (N%)
    WStr$ = MID$("日一二三四五六", N% * 2 + 1, 2)
END FUNCTION

FUNCTION YearStr$ (Y%)
  CONST DG = "零一二三四五六七八九十"
  IF Y% < 0 THEN v$ = "公元前"
  T$ = LTRIM$(STR$(ABS(Y%)))
  FOR I% = 1 TO LEN(T$)
      N% = VAL(MID$(T$, I%, 1))
      v$ = v$ + MID$(DG, N% + N% + 1, 2)
  NEXT
  YearStr$ = v$
END FUNCTION

FUNCTION zStr$ (X%)
    zStr$ = MID$("亥子丑寅卯辰巳午未申酉戍", (X% MOD 12) * 2 + 1, 2)
END FUNCTION

卅

已经下了,谢谢楼主提供

三克油！